perm filename TOP6[AM,DBL]3 blob
sn#198218 filedate 1976-01-24 generic text, type T, neo UTF8
(FILECREATED "24-JAN-76 13:11:32" <LENAT>TOP6.;31 228763
changes to: BLOWUP-COALES HANDLE-I1 RUN-OPS-TO-GET ABC5 DEFN INIT-VARS BLOWUP-RESTRIC CANON-SUG CAVG SMALLER
previous date: "26-DEC-75 14:41:07" <LENAT>TOP6.;30)
(LISPXPRINT (QUOTE TOP6COMS)
T T)
[RPAQQ TOP6COMS
((FNS @ ABBREV ABBREV1 ABC1 ABC2 ABC3 ABC4 ABC5 ABF1 ABF2 ABV1 ABV2 AC-EXS-FILLIN1 AC-EXS-SUGG AC-XNB-FILLIN1
AC-XNB-SUGG ACCESS ACEX ACEX-COPY ACEXA ACX1 ACXE ADD-CANDS ADD1CAND ADD1KIL ALL-BUT-LAST
ALREADY-COALESCED ALREADY-COMPOSED ALREADY-MAP-JOINED ALREADY-MAP-REPLACED ALREADY-MAP-REPLACED2 ANY1OF
ANY1OF-SATISFYING ANY1SAT ANY2OF-SATISFYING ANY2SAT ANY3OF-SATISFYING ANY3SAT APPENDB APPLYB-DEFN
APPLYB-P AQ-LIST ARE-EQUI1 ARE-EQUIV ARE-NOT-EQUIV ARG-CHECK ARG-SUBST ATOM-INT AVG2 BAG BIGGEST
BLIND-SEARCH BLOWUP-CANR BLOWUP-COALES BLOWUP-COMPOSE BLOWUP-INTERESTING-SPEC BLOWUP-INV BLOWUP-MAP-JOIN
BLOWUP-MAP-REPLACE BLOWUP-MAP-REPLACE2 BLOWUP-NEW-SPEC BLOWUP-RESTRIC BOOST BOOST1 BPFS BRIEF-U
BRIEFLITE BRIEFNOT BRIEFULL CADDDDR CAN-BE-1-STYPE CANON-SUG CAVG CHECK-RES CINL CLASS CLASS-IF-NNIL
COMMENT CON-MERGE-ARGS CONFIRM-RPART CONSTANTT CONTRAST-DEFNS CPRIN1 CPRIN1S CR-INVERT CREATEB DE-THRESH
DECRB DEDUCE-CANON DEDUCE-CANON-OBJ DEDUCE-RPART DEFB DEFN-AC DO-KILS DOTPROD DOTS DRAND-PERMUTE
DSET-DIFF DWIMUSERFN EAVG2 ENGC ENGN ENGR ENSURE ENSURE-TOP ENSURE1 EPRIN1 EPRIN1S EQPE ESUB2 EVERY2
EXPERIMENT-MUL EXPERIMENT-ORD FIL-ACEX FIL-EX1 FIL-EX2 FIL-EX3 FIL-STRUC-P FIND-NEW-CANDS FIRSTN FLATTEN
FORMAT FOU FOU1 FOU2 FRIPPLE-G FRIPPLE-S FSET-NTH GARGS GATH GEARGS GENL1RDEF GENLIZE-RECDEF GET-NAMES
GET-SEEN GET-UCON GET-VERBO GET-WAIT GETARGS GETB-OR GETB-P GETB-P-C GETBQ GETFNAME GETU GETUP GETUPN
GETX GETXB GETXNB GEXADD GFNAME GFNAMES GLUE GLUE-CANO GLUE-IF-ABLE GLUEC GLUEE GRAND-STRUC GS-CHECK
GTRANSFER HANDLE-CANON HANDLE-I HANDLE-I-INTERRUPT HANDLE-I1 HANDLE-N I-USED I-USED2 I-USED3 IMATRIX
IN-A-LOOP IN-FACTOR INCR INCR-TIE INCR-USED INCRB INDUCE-CANON-STYPE INIT-VARS INS1CAND INSTAN-1D
INSTAN-1I INSTAN-1S INSTAN-ACT-TRANS INSTAN-BASE INSTAN-D INSTAN-I INSTAN-PAT INSTAN-REC INSTAN-S
INSTAN-TRANSF INT-CONS INT-ENUF INT-PREDS INV-EX INV-STYP INVQ IS-CON IS-CON-L IS-CONN IS-CONSTANTT
IS-ONE-OF ISA ISA1 ISAG ISAS ISQ IVOP-CHK1 IVOP-FIL1 KILB KINDS-OF LAPP LARGER LASTELE LINN LLOCATE
LLOCX LONGEST M2 MAKE-IDENTICAL MAP-JOINABLE MAP-REPLACE2ABLE MAP-REPLACEABLE MAPAPPEND MAX2 MAXI
MERGE2BS MIN2 MOST-OF MULT-STRUC-PAIR NCONCB NEWNAME NOT-USED-YET ONE-ISA ONE-ISAG ORD-STRUC-PAIR
ORDINAL OSET OUTA PAD PAD1 PADI PAIR PGET PICK-CAND POR PRINES PRINICE PRUNABLE PRUNE PSUF PUTB PXEQ Q
RAISE-WORTH RAND-ACEX-MEMB RAND-CON RAND-INCRB RAND-MEMB RAND-OBJ RAND-PERMUTE RAND-PRED RAND-SUBSET
RAND-THING RAND-USER RANDQMEMB RCON REBB RECENTLY-TRIED RECTANGLE REM-ALLEV REM-ONCE RENAME2BS
RIGHT-STRUC RIPPLE RIPPLE-L RIPPLE-S2 RIPPLE-UNTIL RIPPLE-UNTIL-P RMUL RNUM RPLACINT RUN-ANAS
RUN-OPS-TO-GET RUN1ANA S-DECODE SAD2 SAD3 SADD SCDR SELF SELF-COMPILE SELF-INT SET-DIFF SET-DIFFER2
SET-DIFFERENCE SET-NTH SETB SETBQ SIMPLIFY1 SIMULT-SATISFY SMALLER SOFS SOFS-DECODE SOME-EBP SOMEE SORD
SORTED SORV SPECL1RDEF SPECLIZE-RECDEF SPECLIZE-TRANSDEF SPLIST SSORT STACK-BS START STRUC STRUC-PAIR
STRUCHECK STRUCTYP? STRUCTYPE SUB-ONCE SUBSET-INVOLVING-ONLY SUGGEST SWHY SWITCH SYM-XEQ TIMES1000 TLOOP
TYPE UNFORGETTABLE UNTANGLE-ARGS UP-THRESH UPDATE USED-YET VECTOR XEQ-CAND)
(FNS INIT1 INIT-COMP INIT-C)
FACETS
(FNS * FACETS)
(RECORDS WORTH)
RANDSTATE
[P (INIT-COMP)
(INIT1)
(ADVISE (QUOTE MAKEFILE)
(QUOTE BEFORE)
(QUOTE (WIDEPAPER T)))
(ADVISE (QUOTE MAKEFILE)
(QUOTE AFTER)
(QUOTE (WIDEPAPER NIL]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA VECTOR TYPE STRUC SPLIST SADD PAIR OSET FORMAT EPRIN1S EPRIN1 CPRIN1S CPRIN1
COMMENT CLASS BAG ANY1OF)
(NLAML VIEW UP-NOT UP TIES SUGG SPEC INV INTU INT IN-RAN-OF IN-DOM-OF GENL FILLIN
EXS-NOT-BDY EXS-NOT EXS-BDY EXS DEFN-SUF DEFN-NEC DEFN D-R CHECK ANAS ALGS WORTH
SWITCH SWHY SETBQ SELF-COMPILE SELF Q INCR GETBQ BLIND-SEARCH AQ-LIST ANY3SAT
ANY2SAT ANY1SAT ACEX-COPY ACEX]
(DEFINEQ
(@
[LAMBDA (Z)
Z])
(ABBREV
[LAMBDA (S I N1 N2)
(COND
[(SETQ N2 (STRPOSL PUNC2 S N1))
(NCONC [LINN (MKATOM (SUBSTRING S N1
(SMALLER (SUB1 N2)
(IPLUS I (SUB1 N1]
(LINN (MKATOM (SUBSTRING S N2 N2)))
(ABBREV S I (ADD1 N2]
((STRINGP S)
(LINN (MKATOM (SUBSTRING S N1 (SUB1 (IPLUS I N1])
(ABBREV1
[LAMBDA (S I)
(PACK (ABBREV S [IQUOTIENT I (PROG ((N2 0)
(N3 1))
L1 (COND
((SETQ N3
(STRPOSL PUNC2 S N3))
(INCR N3)
(INCR N2)
(GO L1))
((RETURN (ADD1 N2]
1])
(ABC1
[LAMBDA NIL
(MAPC (GETB CS-B (QUOTE GENL))
(FUNCTION (LAMBDA (G MOTI CE)
(SETQ CE (ACX1 CS-B))
(COND
([MOST-OF (APPLY* (QUOTE ACEX)
G)
(FUNCTION (LAMBDA (E)
(MEMBER E CE] (* Then maybe this new specialization
isn't really any more specialized that
its generalization G)
(COND
([SOME (GETB CS-B (QUOTE EXS-NOT-BDY))
(FUNCTION (LAMBDA (NE)
(AND (DEFN-AC G NE)
(INCRB G (QUOTE EXS)
NE] (* Aha; some non-ex of CS-B passes the
looser requirements of G)
)
([SOME (SETQ GTEMP351 (SET-DIFF (ACX1 G)
CE))
(FUNCTION (LAMBDA (E) (* Here we recheck that the ex really is
an ex of G)
(AND (NOT (DEFN-AC CS-B E))
(OR (DEFN-AC G E)
(BOOST1 CS-INT (QUOTE CHECK)
G
(QUOTE EXS)
NIL
(SPLIST In particular COMMA we know that E incorrectly called an
example
of G))
(BOOST1 CS-INT (QUOTE CHECK)
G
(QUOTE EXS-BDY)
NIL
(SPLIST In particular COMMA we know that E incorrectly called an
example
of G)))
(INCRB CS-B (QUOTE EXS-NOT-BDY)
E] (* Aha; some ex of G fails the stringent
requirements of CS-B)
)
(T (* There is now much evidence that G is
no more general than CS-B)
[SETQ MOTI (IPLUS 10 INTHRESH (LENGTH (GETB CS-B (QUOTE EXS)))
(LENGTH (GETB CS-B (QUOTE EXS-NOT)))
(LENGTH (GETB CS-B (QUOTE EXS-NOT-BDY)))
(LENGTH (GETB G (QUOTE EXS-NOT-BDY)))
(LENGTH (GETB G (QUOTE EXS-NOT)))
(LENGTH (GETB G (QUOTE EXS]
(CPRIN1S 6 CRLF CRLF Based
on empirical experiments COMMA AM believes that CS-B may really be no more specialized than G
DCR CRLF)
(COND
[(AND (NULL GTEMP351)
[SETQ GTEMP352 (REMOVE CS-B (GETB G (QUOTE SPEC]
(NOTANY GTEMP352 (QUOTE ACEX)))
(CPRIN1S 6 Closer inspection reveals that the evidence
for this was quite flimsy DCR AM will wait
until some examples
of any
of these have been found COLON GTEMP352 COMMA and
then see
if they truly also are CS-B APOS DCR)
(MAPC GTEMP352
(FUNCTION (LAMBDA (S)
(BOOST1 (IQUOTIENT CS-INT (ADD1 (LENGTH GTEMP352)))
(QUOTE FILLIN)
S
(QUOTE EXS)
NIL
(SPLIST Examples
of S may disprove the weak conjecture that all G APOS are necessarily
CS-B APOS]
(T (CPRIN1S 7 AM conjectures that G and CS-B are equivalent DCR)
(ARE-EQUIV G CS-B MOTI])
(ABC2
[LAMBDA NIL
(SETQ GNEKNT (IPLUS GNEKNT (IDIFFERENCE (LENGTH (GETB CS-B (QUOTE EXS)))
(LENGTH (SETQ GEXISTING (SETB CS-B (QUOTE EXS)
(SET-DIFFERENCE
(SELF-INT (GETB CS-B (QUOTE EXS)))
(NCONC (MAPCONC (GETB CS-B (QUOTE SPEC))
(QUOTE ACEX-COPY))
(GETB CS-B (QUOTE EXS-BDY])
(ABC3
[LAMBDA NIL
(MAPC (GETB CS-B (QUOTE EXS))
(FUNCTION (LAMBDA (X)
(COND
[(APPLY (QUOTE DEFN)
(COND
((ISA CS-B (QUOTE ACTIVE))
(CONS CS-B X))
(T (LIST CS-B X]
(CS-FAIL (GTRANSFER X (QUOTE NOT-BDY))
(INCR GNEKNT))
(T (GTRANSFER X (QUOTE BDY))
(INCR GQEKNT])
(ABC4
[LAMBDA NIL
(MAPC (GETB CS-B (QUOTE SPEC))
(FUNCTION (LAMBDA (S)
(COND
((GETB S (QUOTE DEFN))
(SETB CS-B (QUOTE EXS)
(SUBSET (GETB CS-B (QUOTE EXS))
(FUNCTION (LAMBDA (X)
(COND
((APPLYB-DEFN S (QUOTE DEFN)
X)
(INCRB S (QUOTE EXS)
X)
(BOOST1 (IQUOTIENT CS-INT 2)
(QUOTE CHECK)
S
(QUOTE EXS)
NIL
(SPLIST Some examples of CS-B turned out to be examples of S
as well SEMICOLON They may check out
to be examples of specializations of S))
(INCR GTEKNT)
NIL)
((NOT CS-FAIL)
(RAND-INCRB S (QUOTE EXS-NOT-BDY)
X 5)
T)
(T T])
(ABC5
[LAMBDA (V N X J Z) (* Instead of just ANYB-EXS.CHECK2,
maybe this should really be placed in
ANYB-ANYP.CHECK2)
(SETQ X (GETB CS-B (QUOTE EXS)))
[SETQ V (LARGER 1 (DOTPROD (GETB CS-B (QUOTE WORTH))
(LIST .05 .04 .01] (* V is the number of exs that CS-B is
permitted)
(SETQ N (IDIFFERENCE (LENGTH X)
V))
(COND
((MINUSP N) (* All is well)
T)
((ZEROP N)
(CPRIN1S 9 CRLF CS-B has as many examples as a concept that interesting should have DCR))
(T (* Must remove N examples)
(CPRIN1S 7 CRLF CS-B has (LENGTH X)
examples COMMA but is not interesting enough
to warrant taking up that much space SEMICOLON so about N will be selected at random and forgotten DCR)
(FOR J FROM 1 TO N DO (DREMOVE (PROGN (SETQ Z (RAND-MEMB X))
(CPRIN1S 10 TAB Z CRLF)
Z)
X))
(SETQ GNEKNT (IPLUS GNEKNT N])
(ABF1
[LAMBDA NIL
(SETQ GTEMP309 (DSET-DIFF [ATOM-INT (NCONC (MAPCONC (GETB CS-B (QUOTE GENL))
(QUOTE ACEX-COPY))
(MAPCONC (GETB CS-B (QUOTE SPEC))
(FUNCTION (LAMBDA (Z)
(MAPCONC (GETB Z (QUOTE GENL))
(QUOTE GETX]
(APPLY* (QUOTE ACEXA)
CS-B) (* The reason for ACEXA instead of ACEX
is that actives' defns must be APPLY'ed
to an entry on EXS, whereas an object's
defn is APPLY*'ed)
))
(SETQ GTEMP310 (COND
[(ISA CS-B (QUOTE ACTIVE))
[SETQ GTEMP308 (LENGTH (ANY1OFE (GETB CS-B (QUOTE D-R]
(* This simple equal-length constraint can be replaced by a sophisticated arg-untanling process,
whereby we really can view (x x COMPOSE-x&x) as an example of COA-COMPOSE, convert it to
(x COA-COMPOSE-x), and vice versa if need be)
(SUBSET GTEMP309 (FUNCTION (LAMBDA (Z)
(COND
((NEQ GTEMP308 (LENGTH Z))
(CPRIN1S 10 CRLF This is the bad-D-R match message in ANYB-EXS DCR)
(* Then the example must be of an active
which has a different D-R configuration)
NIL)
[(COND
((ISA CS-B (QUOTE ACTIVE))
(APPLY* (QUOTE DEFN)
CS-B
(CAR Z)
(CADR Z)
(CADDR Z)
(CADDDR Z)
(IPLUS (CLOCK 2)
CS-INT)))
(T (APPLY* (QUOTE DEFN)
CS-B Z NIL NIL NIL (IPLUS (CLOCK 2)
CS-INT]
(CS-FAIL (RAND-INCRB CS-B (QUOTE EXS-BDY)
Z 3)
NIL)
((RAND-INCRB CS-B (QUOTE EXS-NOT-BDY)
Z 5)
(BOOST1 (IDIFFERENCE (AVG2 CS-INT INTHRESH)
10)
(QUOTE CHECK)
CS-B
(QUOTE EXS-NOT-BDY)
NIL
(SPLIST Some (ENGN (QUOTE EXS-NOT-BDY))
were recently added
to CS-B COMMA entries that are positive examples of cousins of CS-B))
NIL]
(T (SUBSET GTEMP309 (FUNCTION (LAMBDA (Z)
(COND
[(COND
((ISA CS-B (QUOTE ACTIVE))
(APPLY* (QUOTE DEFN)
CS-B
(CAR Z)
(CADR Z)
(CADDR Z)
(CADDDR Z)
(IPLUS (CLOCK 2)
CS-INT)))
(T (APPLY* (QUOTE DEFN)
CS-B Z NIL NIL NIL (IPLUS (CLOCK 2)
CS-INT]
(CS-FAIL (RAND-INCRB CS-B (QUOTE EXS-BDY)
Z 3)
NIL)
((RAND-INCRB CS-B (QUOTE EXS-NOT-BDY)
Z 5)
(BOOST1 (IDIFFERENCE (AVG2 CS-INT INTHRESH)
10)
(QUOTE CHECK)
CS-B
(QUOTE EXS-NOT-BDY)
NIL
(SPLIST Some (ENGN (QUOTE EXS-NOT-BDY))
were recently added
to CS-B COMMA entries that are positive examples of cousins of CS-B))
NIL])
(ABF2
[LAMBDA (BA1 BA2)
(PROG1 NIL [SETQ GEXISTING (SETB CS-B (QUOTE EXS)
(SORT (GETB CS-B (QUOTE EXS))
(QUOTE COUNT]
(* This is commented so as not to screw up the "real" exs.
(AND ORIG-EMP GEXISTING (PROGN (TAG-DOMAIN) (TAG-RANGE))) Maybe we might mention these in the AID
part of the Being; the In-dom-of and In-ran-of make it almost not worth bothering)
(BOOST1 (RMUL CS-INT 6 7)
(QUOTE CHECK)
CS-B
(QUOTE EXS)
NIL
(SPLIST Some new COMMA unchecked examples of CS-B have recently been added))
(SWHY 2 NIL)
(SETQ TMP11 NIL)
(COND
((NULL GEXISTING)
(SWHY 7 (No examples of (@ CS-B)
were found; there is no reason
to even consider specializing it further))
NIL)
([NOT (SETQ GADVISER (CAR (SOME (RIPPLE CS-B (QUOTE GENL))
(FUNCTION (LAMBDA (B)
(SETQ INT-THRESH (IPLUS 10 INT-THRESH))
(SETQ GTEMP9 (SET-DIFFERENCE (INT-ENUF (GETB B (QUOTE INT))
(QUOTE DEFN))
(CAR (LAST (ANY1OFE (GETB CS-B
(QUOTE DEFN]
(SWHY 7 (As I ripple away from the current chosen Being, (@ CS-B)
, I don't see any interestingness features which have a high enough value
(LIST (QUOTE >)
INT-THRESH)
for me to stop and pluck them right now))
NIL)
((PROGN (SETQ ILEV (AVG2 CS-INT 500))
(SETQ NEWB (GLUE (QUOTE INT)
CS-B))
(IS-CON NEWB))
(SWHY 7 (The New Being (LIST NEWB)
turned out to already exist!))
NIL)
(T (INCR-USED GUSED GADVISER NEWB)
(* For each interestingness feature that is included into the definition of Newb, we must write "NEWB"
next to the place where that feature originated: the proper entry on the INT part of Gadviser)
(SWHY 2 (Some very interesting (LIST (QUOTE >)
INT-THRESH)
features were assembled, on the advice of (@ GADVISER)
, and their combination has
never been seen before))
(SETQ TMP11 T)
(CPRIN1S 2 CRLF Creating new Being COMMA similar to CS-B COMMA named NEWB COMMA but restricted so
as to make it more interesting DOT CRLF)
(CPRIN1S 5 TAB An NEWB is any CS-B for which [CDDDR (MAPCONC (CDR GENG)
(FUNCTION (LAMBDA (Z)
(APPEND (QUOTE (; And, also:))
(CDR Z]
DCR)
(BLOWUP-INTERESTING-SPEC BA1 BA2)))
(COND
((NULL TMP11)
(SETQ INT-THRESH (AVG2 INT-THRESH INIT-INT-THRESH))
(CPRIN1S 7 Won't try to create a restricted interesting version of CS-B DCR])
(ABV1
[LAMBDA (BA1)
(PROG1 NIL (SETQ GTEMP5 (RIPPLE BA1 (QUOTE GENL)))
(* The basic idea here, of which the following two pgms are just tiny special cases, is that of:
(1) Find an Active, probably an Op but maybe a Pred, whose domain is a genl of BA3
(the description of the thing you have) (actually: BA2 is in its domain) and whose range is a spec
of BA1 (description of the tning you want) (2) Apply it! NOTE: Second-order: Only 1 comp of dom of
Active A is a genl of BA3 (or, equiv, has its defn predicate satisfied by BA2); then we must garner
the other domain elements somehow and apply the active;
this sounds cominatorially unsound, so do it only if there are reasonable thaning lying around to
fill into those other slots.)
])
(ABV2
[LAMBDA (BA1 BA3 BA2)
(MAPCONC (EXS OPERATION)
(FUNCTION (LAMBDA (F) (* We should probably put a time check
on this one, since Exs
(Op) may get very big someday)
(AND [SETQ GTEMP47 (CAR (GETB F (QUOTE D-R]
(ISAG (CAR (LAST GTEMP47))
BA1)
[SETQ GTEMP48 (COND
(BA3 (IS-ONE-OF BA3 (ALL-BUT-LAST GTEMP47)))
((CAR (SOME (ALL-BUT-LAST GTEMP47)
(FUNCTION (LAMBDA (Z)
(AND (IS-CON Z)
(APPLYB Z (QUOTE DEFN)
BA2]
[SETQ GTEMP49 (NCONC (LIST (QUOTE APPLYB)
(KWOTE F)
(Q ALGS))
(MAPCAR (ALL-BUT-LAST GTEMP47)
(FUNCTION (LAMBDA (Z)
(COND
((EQ Z GTEMP48)
Z)
(T NIL]
(CAR (SETQ GTEMP50 (ERRORSET GTEMP49)))
(PROGN (CPRIN1S 50 CRLF TAB Can view GTEMP48 as a (CAR (LAST GTEMP47)) by applying F DCR)
GTEMP50])
(AC-EXS-FILLIN1
[LAMBDA NIL
(AND (GETB CS-B (QUOTE ALGS))
[SETQ GTEMP125 (CAR (SOME (GETB CS-B (QUOTE D-R))
(FUNCTION (LAMBDA (DR)
(AND (EVERY (SETQ CROS (MAPCAR (ALL-BUT-LAST DR)
(QUOTE ACEX)))
(QUOTE LISTP))
CROS]
(PROG (TKNT CORG RLST (EK2 0)
(NEK2 0))
(CPRIN1S 6 CRLF Record of attempts to find examples COLON)
(SETQ TKNT (IPLUS (SETQ CORG (CLOCK 2))
(ITIMES CS-INT 100))) (* GTEMP125 is a flag indicating that we
have not yet tried to emphasize the
boundary examples and use them as
arguments)
(SETQ RLST (LIST T))
[SETQ GTEMP127 (COND
((ISA CS-B (QUOTE PREDICATE))
(QUOTE GTEMP131))
(T (QUOTE GTEMP128]
L18 (SETQ GTEMP130 (MAPCAR CROS (QUOTE RANDQMEMB))) (* GTEMP130 is a random vector from the
space of possible arguments of CS-B)
(SETQ GTEMP129 (APPEND (LIST (QUOTE APPLYB)
(KWOTE CS-B)
(Q ALGS))
GTEMP130)) (* GTEMP129 is the fully formed "call"
on CS-B, with arguments GTEMP130)
(SETQ GTEMP131 (MAPCAR GTEMP130 (QUOTE CADR)))
[COND
((SETQ GTEMP128 (EVAL (COPY GTEMP129))) (* GTEMP128 is the value returned by
this call on CS-B)
(CPRIN1S (IPLUS 7 (ITIMES EK2 7))
CRLF An ex LPAREN sought RPAREN is COLON (EVAL GTEMP127))
(* To get to this point, the call must
have been OK; ie, an non-example was
found even though we didn't want one)
(SETQ EK2 (ADD1 EK2))
(CPRIN1 6 (QUOTE +))
(NCONC1 RLST (NCONC1 GTEMP131 GTEMP128)))
(T (SETQ NEK2 (ADD1 NEK2))
(CPRIN1 6 (QUOTE -))
(COND
((ILESSP NEK2 7)
(CPRIN1S (IPLUS 8 (ITIMES NEK2 15))
CRLF An LPAREN unsought RPAREN non-ex is COLON (QUOTE args=)
GTEMP131 COMMA (QUOTE result=)
GTEMP128)
(INCRB CS-B (QUOTE EXS-NOT-BDY)
GTEMP131]
(COND
((OR (IGREATERP NEK2 150)
(IGREATERP EK2 25)
(IGREATERP (CLOCK 2)
TKNT))
(CPRIN1S 7 CRLF)
(CPRIN1S 6 CRLF Found EK2 examples LPAREN and NEK2 non-exs RPAREN COMMA
in (QUOTIENT (IDIFFERENCE (CLOCK 2)
CORG)
1000.0)
secs DOT CRLF)
(COND
((ILESSP (ITIMES 6 EK2)
NEK2)
(CPRIN1S 6 Ratio of exs
to non-exs is too low LPAREN EK2 / NEK2 RPAREN SEMICOLON Exs are too sparse DCR TAB AM will
sometime try
to generalize CS-B DCR)
(BOOST1 [COND
((ZEROP EK2)
CS-INT)
(T (SMALLER (SUB1 CS-INT)
(RMUL 13 NEK2 (ADD1 EK2]
(QUOTE FILLIN)
CS-B
(QUOTE GENL)
NIL
(SPLIST The ratio of examples
to non-examples of CS-B is too low SEMICOLON CS-B is too specialized COMMA too narrow)
))
((AND (ISA CS-B (QUOTE PREDICATE))
(IGREATERP EK2 7)
(ILESSP NEK2 3))
(CPRIN1S 6 Only NEK2 non-examples were encountered DOT Examples are too dense DCR TAB AM will
sometime try to find some non-exs of CS-B DCR)
(BOOST1 (RMUL (IPLUS CS-INT EK2)
EK2 25)
(QUOTE FILLIN)
CS-B
(QUOTE EXS-NOT-BDY)
NIL
(SPLIST Examples of CS-B are too dense SEMICOLON before deciding
to specialize CS-B we should actively try to find more non-examples)))
(T (CPRIN1S 7 A nice ratio of exs/non-exs was encountered for CS-B CRLF)))
(RETURN (CDR RLST)))
((AND GTEMP125 (ILESSP (ITIMES (ADD1 EK2)
15)
NEK2))
[MAP2C GTEMP125 CROS (FUNCTION (LAMBDA (G C)
(NCONC C (APPLY* (QUOTE EXS-BDY)
G]
(SETQ GTEMP125 NIL)))
(GO L18])
(AC-EXS-SUGG
[LAMBDA NIL
(MAPCONC PAST
(FUNCTION (LAMBDA (PE)
(SETQ GTEMP39 (P-B PE))
(COND
((AND (FMEMB (P-P PE)
(LIST (QUOTE EXS-NOT-BDY)
(QUOTE EXS-NOT)))
(EQ (P-OP PE)
(QUOTE FILLIN))
[AND (NULL (GETB GTEMP39 (QUOTE EXS-NOT-BDY)))
(NULL (GETB GTEMP39 (QUOTE EXS-NOT]
(ISA PE (QUOTE ACTIVE))) (* That is, did we try and fail to fill
in non-exs of GTEMP39)
(SETQ GTEMP36 (LIST (QUOTE FILLIN)
GTEMP39
(QUOTE EXS)))
(SETQ GTEMP37 (SASSOC GTEMP36 PAST)) (* Did we try recently to fill in
examples)
(COND
[(NULL GTEMP37) (* No, so let's suggest trying that)
(LIST (LIST GTEMP36 (DOTPROD (GETB GTEMP39 (QUOTE WORTH))
(LIST .4 .1))
(LIST (SPLIST Failed to find non-examples
of PE -ing COMMA and have not recently tried
to find examples of it SEMICOLON We may get non-examples indirectly
when we now search for examples]
[(OR (GETB GTEMP39 (QUOTE EXS))
(GETB GTEMP39 (QUOTE EXS-BDY))) (* Yes, we tried and in fact succeeded)
(* We have tried to fill in non-examples
and examples of the Being, but failed to
find any non-examples.
It is too general)
[SET-NTH (GETB GTEMP39 (QUOTE WORTH))
1
(AVG2 1 (CAR (GETB GTEMP39 (QUOTE WORTH]
(COND
((ISA GTEMP39 (QUOTE PREDICATE))
(CPRIN1S 5 CRLF AM conjectures that the predicate GTEMP39 always returns True DCR)
(SWHY 5 (Based on empirical evidence: no non-examples were found))
(CPRIN1S 7 Note this means that all GTEMP39 APOS generalizations would also
always return True DCR CRLF)
(* Here we should boost1 conjecturing that this fact is true, and not bothering as much
(lower int) filling in examples of generalizations of CS-B.
Also, if GTEMP39 is a COA, then we don't want to coalesce any of its genls, since they'll just turn
out to be True always)
(BOOST1 (SUB1 CS-INT)
(QUOTE CHECK)
(QUOTE CONJEC)
(QUOTE EXS)
NIL
(SETQ GSP1
(SPLIST It would be interesting to learn that GTEMP39 is the constant predicate
True)))
(INCRB (QUOTE CONJEC)
(QUOTE EXS)
(LIST (LIST (QUOTE ALWAYS-RETURNS)
GTEMP39 TRUE)
(SUB1 CS-INT)
GSP1))
NIL))
(LIST (LIST (LIST (QUOTE FILLIN)
GTEMP39
(QUOTE SPEC))
(DOTPROD (GETB GTEMP39 (QUOTE WORTH))
(LIST 1.4 .5 .1))
(LIST (SPLIST Failed to
find non-examples
of PE -ing COMMA but have recently found some examples SEMICOLON PE is
too general COMMA too easy
to satisfy]
(T (* Failed on both accounts, so the
problem is just too tough for now.)
NIL])
(AC-XNB-FILLIN1
[LAMBDA NIL
(AND (GETB CS-B (QUOTE ALGS))
[SOME (GETB CS-B (QUOTE D-R))
(FUNCTION (LAMBDA (DR)
(AND (EVERY [SETQ CROS (MAPCAR (ALL-BUT-LAST DR)
(FUNCTION (LAMBDA (Z)
(COND
[(SETQ TMP3 (APPLY* (QUOTE EXS-BDY)
Z))
(APPEND TMP3 (FIRSTN (LARGER 7 (LENGTH TMP3))
(APPLY* (QUOTE ACEX)
Z]
((APPLY* (QUOTE ACEX)
Z]
(QUOTE LISTP))
CROS]
(PROG (TKNT CORG RLST (EK2 0)
(NEK2 0))
(CPRIN1S 6 CRLF Record of attempts to find non-examples COLON)
[SETQ TKNT (IPLUS (SETQ CORG (CLOCK 2))
(ITIMES CS-INT (COND
((ISA CS-B (QUOTE PREDICATE))
100)
(T 7]
(SETQ RLST (LIST T))
[SETQ GTEMP127 (COND
((ISA CS-B (QUOTE PREDICATE))
(QUOTE GTEMP131))
(T (QUOTE GTEMP128]
L18 (SETQ GTEMP130 (MAPCAR CROS (QUOTE RANDQMEMB))) (* GTEMP130 is a random vector from the
space of possible arguments of CS-B)
(SETQ GTEMP129 (APPEND (LIST (QUOTE APPLYB)
(KWOTE CS-B)
(Q ALGS))
GTEMP130)) (* GTEMP129 is the fully formed "call"
on CS-B, with arguments GTEMP130)
(SETQ GTEMP131 (MAPCAR GTEMP130 (QUOTE CADR)))
[COND
((SETQ GTEMP128 (EVAL (COPY GTEMP129))) (* GTEMP128 is the value returned by
this call on CS-B)
(CPRIN1S (IPLUS 8 (ITIMES EK2 7))
CRLF An example LPAREN unsought RPAREN is COLON (EVAL GTEMP127))
(* To get to this point, the call must
have been OK; ie, an example was found
even though we didn't want one)
(SETQ EK2 (ADD1 EK2))
(CPRIN1S 6 (QUOTE +))
(INCRB CS-B (QUOTE EXS)
(NCONC1 GTEMP131 GTEMP128)))
(T (SETQ NEK2 (ADD1 NEK2))
(CPRIN1S (IPLUS 7 (ITIMES NEK2 7))
CRLF A LPAREN sought RPAREN non-example is COLON (EVAL GTEMP127))
(CPRIN1S 6 -)
(NCONC1 RLST (NCONC1 GTEMP131 GTEMP128]
[COND
((OR (IGREATERP NEK2 7)
(IGREATERP EK2 25)
(IGREATERP (CLOCK 2)
TKNT))
(CPRIN1S 18 CRLF)
(CPRIN1S 6 CRLF Found NEK2 non-examples LPAREN and EK2 exs RPAREN COMMA
in (IQUOTIENT (IDIFFERENCE (CLOCK 2)
CORG)
1000.0)
secs DOT CRLF)
(COND
((ILESSP (ITIMES EK2 7)
NEK2)
(CPRIN1S 6 Examples are too sparse DOT Sometime COMMA AM will genlize CS-B DCR)
(BOOST1 (IDIFFERENCE CS-INT EK2)
(QUOTE FILLIN)
CS-B
(QUOTE GENL)
NIL
(SPLIST The ratio of examples
to non-examples of CS-B is too low SEMICOLON CS-B is too specialized COMMA too narrow)
))
((ILESSP (ITIMES (COND
((ISA CS-B (QUOTE PREDICATE))
2)
(T 20))
(ADD1 NEK2))
(SUB1 EK2))
(CPRIN1S 6 Examples too dense COMMA too easy to find DOT Sometime COMMA speclize CS-B DCR)
(BOOST1 (RMUL (IPLUS CS-INT EK2)
EK2 25)
(QUOTE FILLIN)
CS-B
(QUOTE SPEC)
NIL
(SPLIST The ratio of examples
to non-examples of CS-B is too high SEMICOLON CS-B is too generalized COMMA too broad)
))
(T (CPRIN1S 7 A nice ratio of non-exs/exs was encountered for CS-B CRLF)))
(RETURN (CDR RLST]
(GO L18])
(AC-XNB-SUGG
[LAMBDA NIL
(MAPCONC PAST
(FUNCTION (LAMBDA (PE)
(SETQ GTEMP39 (P-B PE))
(COND
((AND (FMEMB (P-P PE)
(LIST (QUOTE EXS)
(QUOTE EXS-BDY)))
(EQ (P-OP PE)
(QUOTE FILLIN))
(NULL (GETB GTEMP39 (QUOTE EXS)))
(NULL (GETB GTEMP39 (QUOTE EXS-BDY)))
(ISA PE (QUOTE ACTIVE))) (* That is, did we try and fail to fill
in exs of GTEMP39)
(SETQ GTEMP36 (LIST (QUOTE FILLIN)
GTEMP39
(QUOTE EXS-NOT-BDY)))
(SETQ GTEMP37 (SASSOC GTEMP36 PAST)) (* Did we try recently to fill in
non-examples)
(COND
[(NULL GTEMP37) (* No, so let's suggest trying that)
(LIST (LIST GTEMP36 (DOTPROD (GETB GTEMP39 (QUOTE WORTH))
(LIST .3 .1))
(LIST (SPLIST Failed to find examples
of PE -ing COMMA and have not recently tried
to find non-examples of it SEMICOLON We may get examples indirectly
when we now search for non-examples]
[(OR (GETB GTEMP39 (QUOTE EXS-NOT-BDY))
(GETB GTEMP39 (QUOTE EXS-NOT))) (* Yes, we tried and in fact succeeded)
(* We have tried to fill in examples and
examples of the Being, but failed to
find any examples. It is too special.)
[SET-NTH (GETB GTEMP39 (QUOTE WORTH))
1
(AVG2 1 (CAR (GETB GTEMP39 (QUOTE WORTH]
(COND
((ISA GTEMP39 (QUOTE PREDICATE))
(CPRIN1S 5 CRLF AM conjectures that the predicate GTEMP39 always returns False DCR)
(SWHY 5 (Based on empirical evidence: no examples were found))
(CPRIN1S 7 Note this means that all GTEMP39 APOS specializations would also
always return False DCR CRLF)
(* Here we should boost1 conjecturing that this fact is true, and not bothering as much
(lower int) filling in examples of specializations of CS-B.
Also, if GTEMP39 is a COA, then we don't want to coalesce any of its specls, since they'll just turn
out to be False always)
[BOOST1 (SUB1 CS-INT)
(QUOTE CHECK)
(QUOTE CONJEC)
(QUOTE EXS)
NIL
(SETQ GSP1
(SETQ GSP1
(SPLIST It would be interesting
to learn that GTEMP39 is the constant predicate False]
(INCRB (QUOTE CONJEC)
(QUOTE EXS)
(LIST (LIST (QUOTE ALWAYS-RETURNS)
GTEMP39
(QUOTE FALSE))
(SUB1 CS-INT)
GSP1))
NIL))
(LIST (LIST (LIST (QUOTE FILLIN)
GTEMP39
(QUOTE GENL))
(DOTPROD (GETB GTEMP39 (QUOTE WORTH))
(LIST 1.4 .5 .1))
(LIST (SPLIST Failed to
find examples
of PE -ing COMMA but have recently found some non-examples SEMICOLON PE
is too specialized COMMA too narrow
to satisfy]
(T (* Failed on both accounts, so the
problem is just too tough for now.)
NIL])
(ACCESS
[LAMBDA (A)
A])
(ACEX
[NLAMBDA (B TAC)
(* Consider a more general scheme, wherein we store EXS, UP,...
of a Being on that Being, with a tag as to its Gcnt of storing;
we Ripple again only if expired. We can throw any or all of these away for space reasons, and no
harm will accrue. An even bolder step is to make this checking an automatic part of the fns EXS,...;
perhaps only if given an extra argument or only if not given one...)
(COND
((AND (SETQ TAC (GETB B (QUOTE FEX)))
(ILESSP GCNT (CAR TAC))
(CDR TAC)))
((CDR (SETB B (QUOTE FEX)
(CONS ACEXPIRE (NCONC (COND
((APPLY* (QUOTE EXS)
B))
(T (BOOST1 (RMUL CS-INT 2 7)
(QUOTE FILLIN)
B
(QUOTE EXS)
NIL
(SPLIST [ENGN (CAR (SEARCHPDL (QUOTE IS-CON]
specifically asked for some examples of B))
NIL))
(APPLY* (QUOTE EXS-BDY)
B])
(ACEX-COPY
[NLAMBDA (B)
(APPEND (APPLY* (QUOTE ACEX)
B])
(ACEXA
[LAMBDA (B)
(MAPCAR (APPLY* (QUOTE ACEX)
B)
(COND
((ISA B (QUOTE ACTIVE))
(QUOTE LASTELE))
(T (QUOTE @])
(ACX1
[LAMBDA (B)
(REMPROP B (QUOTE FEX))
(ACXE B])
(ACXE
[LAMBDA (B)
(APPLY* (QUOTE ACEX)
B])
(ADD-CANDS
[LAMBDA (C)
(MAPC C (FUNCTION (LAMBDA (C1)
(ADD1CAND (CACT C1)
(CINT C1)
(ANY1OFE (CWHY C1])
(ADD1CAND
[LAMBDA (ACT I W C)
(COND
((EQUAL ACT CS-ACT)
(CPRIN1S 10 CRLF Got some reinforcement for working
on current Cand DCR)
(INCR CS-INT)
(SWHY 10 (Someone wanted to add the Cand (@ ACT)
to Cands COMMA but it was already the current Cand))
NIL)
((SETQ C (SASSOC ACT CANDS))
(DREMOVE C CANDS)
[COND
[(MEMBER W (CWHY C))
(RPLACINT C (SETQ I (ADD1 (LARGER I (CINT C]
(T (ATTACH W (CWHY C))
(RPLACINT C (CAVG I (CINT C]
(INS1CAND C I))
(T (INS1CAND (MAKE-CAND ACT I (LIST W))
I])
(ADD1KIL
[LAMBDA (G B P W E)
(ATTACH (LIST G B P W E)
(SOME KILS (FUNCTION (LAMBDA (K)
(ILESSP G (CAR K])
(ALL-BUT-LAST
[LAMBDA (L)
(LDIFF L (FLAST L])
(ALREADY-COALESCED
[LAMBDA (BA1 BA2) (* Returns X if BA2 is equivalent to any
existing coalescing X of BA1)
(AND (IGREATERP [LENGTH (CAR (GETB BA1 (QUOTE D-R]
2)
(SETQ GTEMP210 (GLUE (QUOTE COA)
BA1))
(IS-CON GTEMP210)
[SETQ GTEMP310 (CONS GTEMP210 (MAPCONC (LIST 1 2 3 4)
(FUNCTION (LAMBDA (I)
(LINN (IS-CON (GLUE GTEMP210 I]
(SETQ GTEMP311 (CAR (SOME GTEMP310 (FUNCTION (LAMBDA (Z)
(ARE-EQUIV BA2 Z])
(ALREADY-COMPOSED
[LAMBDA (BA1 BA2)
(COND
([NOT (AND BA1 BA2 (ISA BA1 (QUOTE OPERATION))
(ISA BA2 (QUOTE OPERATION]
NIL)
((IS-CON (SETQ GTEMP12 (GLUEC BA1 BA2)))
[SETQ GUP1 (COND
((ISAG CS-B (QUOTE COMPOSE))
CS-B)
(T (QUOTE COMPOSE]
(INCRB GUP1 (QUOTE EXS)
(NCONC1 (GEARGS GUP1)
GTEMP12))
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
GTEMP12)
([SETQ GTEMP11 (SOME [SETQ GTEMP200 (NCONC (MAPCAR (EXS-BDY COMPOSE)
(QUOTE LASTELE))
(MAPCAR (EXS COMPOSE)
(QUOTE LASTELE]
(FUNCTION (LAMBDA (Z)
(SOME (GETB Z (QUOTE DEFN))
(FUNCTION (LAMBDA (D)
(MATCH D WITH ('TYPE 'APPLICATION 'OF & ('APPLYB ('QUOTE 'COMPOSE)
('QUOTE 'ALGS)
('QUOTE =BA1)
('QUOTE =BA2)
$]
(CPRIN1S 75 The composing of BA1 and BA2 was already done COMMA in the concept named (CAR GTEMP11))
(SETQ GTEMP12 (CAR GTEMP11])
(ALREADY-MAP-JOINED
[LAMBDA (S OP1 OP2)
(AND (ISA OP2 (QUOTE ACTIVE))
(MAP-JOINABLE S OP1)
[SOME (ACEX MAP-JOIN)
(FUNCTION (LAMBDA (E)
(AND (ISAS S (CAR E))
(ISAS OP1 (CADR E))
(ARE-EQUIV OP2 (CADDR E]
OP2])
(ALREADY-MAP-REPLACED
[LAMBDA (S OP1 OP2)
(AND (ISA OP2 (QUOTE OPERATION))
(MAP-REPLACEABLE S OP1)
[SOME (ACEX MAP-REPLACE)
(FUNCTION (LAMBDA (E)
(AND (ISAS S (CAR E))
(ISAS OP1 (CADR E))
(ARE-EQUIV OP2 (CADDR E]
OP2])
(ALREADY-MAP-REPLACED2
[LAMBDA (S S2 OP1 OP2)
(AND (ISA OP2 (QUOTE OPERATION))
(MAP-REPLACE2ABLE S S2 OP1)
[SOME (ACEX MAP-REPLACE2)
(FUNCTION (LAMBDA (E)
(AND (ISAS S (CAR E))
(ISAS S2 (CADR E))
(ISAS OP1 (CADDR E))
(ARE-EQUIV OP2 (CADDDR E]
OP2])
(ANY1OF
[NLAMBDA Z (* EVAL (RAND-MEMB Z))
(EVAL (CAR Z])
(ANY1OF-SATISFYING
[LAMBDA (XSET TST)
(AND (LISTP XSET)
TST
(PROG (X)
L11 (SETQ X (RAND-MEMB XSET))
(COND
((EVAL TST)
(RETURN X))
((DREMOVE X XSET)
(GO L11))
(T (RETURN NIL])
(ANY1SAT
[NLAMBDA (XSET TST)
(ANY1OF-SATISFYING (EVAL XSET)
TST])
(ANY2OF-SATISFYING
[LAMBDA (XSET YSET XTST YTST)
(AND XSET YSET XTST YTST (PROG (YS)
L11 (SETQ BA1 (RAND-MEMB XSET))
(COND
((AND (NOT (EVAL XTST))
(SETQ XSET (DREMOVE BA1 XSET)
))
(GO L11))
((NULL XSET)
(RETURN NIL)))
(SETQ YS (APPEND YSET))
L12 (SETQ BA2 (RAND-MEMB YS))
(COND
((EVAL YTST)
(RETURN (LIST BA1 BA2)))
((DREMOVE BA2 YS)
(GO L12)))
(COND
((DREMOVE BA1 XSET)
(GO L11))
(T (RETURN NIL])
(ANY2SAT
[NLAMBDA (XSET YSET XTST YTST)
(ANY2OF-SATISFYING (EVAL XSET)
(EVAL YSET)
XTST YTST])
(ANY3OF-SATISFYING
[LAMBDA (XS YS ZS XT YT ZT V3)
(AND XS YS ZS XT YT ZT [SETQ ZS (COND
((NLISTP ZS)
(LIST ZS))
(T (RAND-PERMUTE ZS]
[SETQ YS (COND
((NLISTP YS)
(LIST YS))
(T (RAND-PERMUTE YS]
[SETQ XS (COND
((NLISTP XS)
(LIST XS))
(T (RAND-PERMUTE XS]
[SOME XS (FUNCTION (LAMBDA (BA1)
(AND (EVAL XT)
(SOME YS (FUNCTION (LAMBDA (BA2)
(AND (EVAL YT)
(SOME ZS (FUNCTION (LAMBDA (BA3)
(AND (EVAL ZT)
(SETQ V3 (LIST BA1 BA2 BA3]
(SETQ BA1 (CAR V3))
(SETQ BA2 (CADR V3))
(SETQ BA3 (CADDR V3))
V3])
(ANY3SAT
[NLAMBDA (XS YS ZS XT YT ZT)
(ANY3OF-SATISFYING (EVAL XS)
(EVAL YS)
(EVAL ZS)
XT YT ZT])
(APPENDB
[LAMBDA (B P L)
(AND (LISTP L)
(IS-CON B)
(SETB B P (SELF-INT (APPEND (GETB B P)
L])
(APPLYB-DEFN
[LAMBDA (B P A)
(COND
((ISA B (QUOTE ACTIVE))
(APPLY B (CONS P A)))
(T (APPLYB B P A])
(APPLYB-P
[LAMBDA (B)
(APPLYB B P BA1 BA2 BA3 BA4])
(AQ-LIST
[NLAMBDA (B A1 A2 A3 A4)
(LIST (QUOTE APPLYB)
(KWOTE (EVAL B))
(Q ALGS)
A1 A2 A3 A4])
(ARE-EQUI1
[LAMBDA (X1 X2 MOTI) (* We know that X1 nd X2 are equivalent
concepts. Decide either to merge them or
to merely tag them as such)
(COND
((AND (NUMBERP MOTI)
(IGREATERP MOTI INTHRESH))
(MERGE2BS X1 X2)
X1)
(T [INCRB X1 (QUOTE TIES)
(LIST X2 (LIST (QUOTE DEFN)
(QUOTE EQUIV]
[INCRB X2 (QUOTE TIES)
(LIST X1 (LIST (QUOTE DEFN)
(QUOTE EQUIV]
X2])
(ARE-EQUIV
[LAMBDA (X1 X2 MOTI SP1)
(COND
((EQUAL X1 X2))
[(FMEMB (QUOTE EQUIV)
(FASSOC (QUOTE DEFN)
(CDR (FASSOC X1 (GETB X2 (QUOTE TIES]
((INTERSECTION (GETB X1 (QUOTE DEFN))
(GETB X2 (QUOTE DEFN)))
(ARE-EQUI1 X1 X2 MOTI))
((INTERSECTION (GETB X1 (QUOTE ALGS))
(GETB X2 (QUOTE ALGS)))
(ARE-EQUI1 X1 X2 MOTI))
(SP1 NIL)
((ARE-NOT-EQUIV X1 X2 MOTI T)
NIL)
[(AND (NUMBERP MOTI)
(IGREATERP MOTI INTHRESH)
(IGREATERP VERBOSITY 3)
(PROGN (CPRIN1S 0 CRLF CRLF Are these two concepts interchangeable QUES CRLF TAB 1 DOT X1 CRLF TAB 2 DOT X2
CRLF LPAREN If you are unsure COMMA just wait a few seconds RPAREN)
(SELECTQ (ASKUSER 8 (QUOTE M)
NIL NIL T NIL)
(Y (ARE-EQUI1 X1 X2 MOTI))
(N (SETQ MOTI NIL))
NIL]
(MOTI
(* We might always want to do this (T), or perhaps only if MOTI exists
(MOTI), or perhaps only if MOTI is hi enuf ((> MOTI x)))
(BOOST1 (OR MOTI (SETQ MOTI (ADD1 INTHRESH)))
(QUOTE CHECK)
(QUOTE CONJEC)
(QUOTE EXS)
NIL
(SETQ SP1 (SPLIST Establishing that X1 is equivalent to X2 would aid CS-ACT)))
(INCRB (QUOTE CONJEC)
(QUOTE EXS)
(LIST (LIST (QUOTE EQUIV)
X1 X2)
MOTI SP1))
NIL])
(ARE-NOT-EQUIV
[LAMBDA (X1 X2 MOTI SP1)
(COND
[(NEQ (LENGTH (GARGS X1))
(LENGTH (GARGS X2]
[(FMEMB (QUOTE INEQUIV)
(FASSOC (QUOTE DEFN)
(CDR (FASSOC X1 (GETB X2 (QUOTE TIES]
(NIL
(* We could go into great detail, checking to see if
there is any symmetric difference in the two Beings'
Examples structure)
)
(SP1 NIL)
((ARE-EQUIV X1 X2 MOTI T)
NIL)
(MOTI (BOOST1 (OR MOTI (SETQ MOTI INTHRESH))
(QUOTE CHECK)
(QUOTE CONJEC)
(QUOTE EXS)
NIL
(SETQ SP1
(SPLIST Establishing that X1 is inequivalent
to X2 would aid CS-ACT)))
(INCRB (QUOTE CONJEC)
(QUOTE EXS)
(LIST (LIST (QUOTE INEQUIV)
X1 X2)
MOTI SP1))
NIL])
(ARG-CHECK
[LAMBDA (A B) (* Note this only checks up to the first
Null argument supplied)
(EVERY2 (ANY1OFE (GETB B (QUOTE D-R)))
A
(QUOTE DEFN])
(ARG-SUBST
[LAMBDA (ARG1 NEW1 ARG2 NEW2)
[SET ARG1 (CAR (DSUBST NEW1 ARG1 (DSUBST NEW1 (LIST (QUOTE COPY)
ARG1)
(DSUBST NEW2 ARG2 (DSUBST NEW2 (LIST (QUOTE COPY)
ARG2)
(LIST (COPY (EVAL ARG1]
(SET ARG2 (CAR (DSUBST NEW1 ARG1 (DSUBST NEW1 (LIST (QUOTE COPY)
ARG1)
(DSUBST NEW2 ARG2 (DSUBST NEW2 (LIST (QUOTE COPY)
ARG2)
(LIST (COPY (EVAL ARG2])
(ATOM-INT
[LAMBDA (L M)
(COND
(L (SETQ M (TCONC NIL (CAR L)))
[MAPC (CDR L)
(FUNCTION (LAMBDA (Z)
(COND
((NOT (FMEMB Z (CAR M)))
(TCONC M Z]
(CAR M])
(AVG2
[LAMBDA (N1 N2)
(IQUOTIENT (IPLUS N1 N2)
2])
(BAG
[NLAMBDA X
(CONS (QUOTE BAG)
X])
(BIGGEST
[LAMBDA (L)
(PROG (M)
L1 [COND
((NULL L)
(RETURN M))
((IGREATERP (COUNT (CAR L))
(COUNT M))
(SETQ M (CAR L]
(SETQ L (CDR L))
(GO L1])
(BLIND-SEARCH
[NLAMBDA (TKNT XSET XTST CL2) (* XSET will typically have the form
(CROS X1 X2 X3...), and XTST will be an
evaluable expression involving the free
variables IA1, IA2, IA3,...)
(* The purpose is to randomly pick vectors from the Cross-product indicated, returning a list of all
those which satisfy the test (give a non-NIL result) TKNT indicates the amount of CPU time to expend
before quitting this activity)
[SETQ CL2 (IPLUS (CLOCK 2)
(ITIMES 30 (IPLUS CS-INT TKNT [ITIMES -6 (EVAL (CONS (QUOTE IPLUS)
(MAPCAR (CDR XSET)
(FUNCTION (LAMBDA (Z)
(LENGTH (APPLY* (QUOTE ACEX)
Z]
10]
(SELECTQ (LENGTH XSET)
(0 (HELP))
(1 NIL)
[2 (* So there is just one component to
examine)
(MAPCONC (APPLY* (QUOTE ACEX)
(CADR XSET))
(FUNCTION (LAMBDA (IA1)
(COND
((IGREATERP (CLOCK 2)
CL2)
NIL)
((EVAL XTST)
(LIST (LIST (QUOTE VECTOR)
IA1]
[3 (* So there are 2 domain components to
search along)
(MAPCONC (APPLY* (QUOTE ACEX)
(CADR XSET))
(FUNCTION (LAMBDA (IA1)
(COND
((ILESSP (CLOCK 2)
CL2)
(MAPCONC (APPLY* (QUOTE ACEX)
(CADDR XSET))
(FUNCTION (LAMBDA (IA2)
(COND
((IGREATERP (CLOCK 2)
CL2)
NIL)
((EVAL XTST)
(LIST (LIST (QUOTE VECTOR)
IA1 IA2]
[4 (* So there are 3 domain components to
search along)
(MAPCONC (APPLY* (QUOTE ACEX)
(CADR XSET))
(FUNCTION (LAMBDA (IA1)
(COND
((ILESSP CL2 CL2)
(MAPCONC (APPLY* (QUOTE ACEX)
(CADDR XSET))
(FUNCTION (LAMBDA (IA2)
(COND
((ILESSP (CLOCK 2)
CL2)
(MAPCONC (APPLY* (QUOTE ACEX)
(CADDDR XSET))
(FUNCTION (LAMBDA (IA3)
(COND
((EVAL XTST)
(LIST (LIST (QUOTE VECTOR)
IA1 IA2 IA3]
(CPRIN1S 0 CRLF WARNING: In Blind-search: more than 3 components DOT Giving up DCR CRLF])
(BLOWUP-CANR
[LAMBDA (B F P1 P2)
(* B is the name of the space which is about to be compressed;
F is the name of a canonical mapping of that space into its compressed form, soon to be called NEWB
; P1 is the generalized form of P2, and these two predicates determined the canonical function F)
(SETQ NEWB (NEWNAME (GLUE (QUOTE CANONICAL)
B)))
[COND
((NULL (ACXE B))
(BOOST (QUOTE FILLIN)
B
(QUOTE EXS)
NIL
(SPLIST NEWB exists COMMA so it is worth our time to explore examples of plain old B APOS]
[SETB F (QUOTE D-R)
(CONS (LIST B NEWB)
(GETB F (QUOTE D-R]
(* BOOST1 (SUB1 CS-INT) (QUOTE APPLYB) (QUOTE RESTRICT)
(QUOTE ALGS) (LIST B DEFN (QUOTE TO-RAN-OF) GTEMP12)
(SPLIST Canonical form of B exists SEMICOLON it is worth making that a separate concept))
(CREATEB NEWB)
(INCRB NEWB (QUOTE GENL)
B)
(INCRB B (QUOTE SPEC)
NEWB)
(INCRB NEWB (QUOTE IN-RAN-OF)
F) (* There is much confusion here about
what IN-RAN-OF means: is it subset-of,
intersects-with, contains, is an element
of,...)
(SETB NEWB (QUOTE WORTH)
(MAP2CAR (GETB B (QUOTE WORTH))
(GETBQ CANONIZE WORTH)
(QUOTE CAVG)))
[INCRB NEWB (QUOTE DEFN)
(COND
(GCAN-DEFN (SIMPLIFY1 GCAN-DEFN))
((INDUCE-DEFN NEWB] (* If the defn hasn't already been
assembled, try to infer it from
examples)
(BOOST1 (SUB1 CS-INT)
(QUOTE FILLIN)
NEWB
(QUOTE EXS)
NIL
(SPLIST Any example of NEWB is a canonical example of B))
NEWB])
(BLOWUP-COALES
[LAMBDA (BA1 NNAM)
(CREATEB NNAM) (* NNAM now names new Being)
[SETQ GTEMP213 (LAST (CAR (GETB BA1 (QUOTE D-R] (* GTEMP213 holds the range component of
the Active BA1)
(SETQ GTEMP212 (LDIFF (CAR (GETB BA1 (QUOTE D-R)))
GTEMP213)) (* GTEMP212 now holds a list of the
domain components for BA1)
(SETQ GTEMP214 (RAND-PERMUTE (FMEMB (LENGTH GTEMP212)
GNUMS)))
(SETQ GTEMP215 (RAND-PERMUTE (FMEMB (LENGTH GTEMP212)
GNUMS))) (* GTEMP214 and GTEMP215 are random
permutation of 1,2,..., up to the number
of domain components.)
(COND
([SETQ GTEMP219 (CAR (SOME GTEMP214 (FUNCTION (LAMBDA (N)
(SETQ GTEMP216 (CAR (FNTH GTEMP212 N)))
(SETQ GTEMP220 (CAR (SOME (REMOVE N GTEMP215)
(FUNCTION (LAMBDA (M)
(SETQ GTEMP217 (CAR (FNTH GTEMP212 M)))
(OR (ISAG GTEMP216 GTEMP217)
(AND (ISAG GTEMP217 GTEMP216)
(SETQ GSWI T]
(* GTEMP219 and GTEMP220 are the
positions, and GTEMP216 and GTEMP217 are
the corresponding names, of the 2 domain
components to be coalesced.)
(CPRIN1S 9 CRLF AM will merge the GTEMP219 (ORDINAL GTEMP219) and the GTEMP220 (ORDINAL GTEMP220)
arguments
of BA1 SEMICOLON that is COMMA GTEMP216 and GTEMP217 DCR)
(SWHY 9 (Those 2 args (LIST GTEMP216 GTEMP217)
overlap conceptually, and I want to merge some args together
to reduce the number of different parameters I have to supply to invoke the (@ BA1)
operation))
(COND
(GSWI (SWITCH GTEMP216 GTEMP217)
(SWITCH GTEMP219 GTEMP220))
(T))
(SET-NTH GTEMP212 GTEMP220 GTEMP216) (* NOW GTEMP216 AND GTEMP219 REFER TO A
MORE SPECIFIC BEING THAN GTEMP217 AND
GTEMP220)
(SETQ GTEMP221 (LARGER GTEMP219 GTEMP220))
(INCRB NNAM (QUOTE D-R)
(APPEND (FIRSTN (SUB1 GTEMP221)
GTEMP212)
(FNTH GTEMP212 (ADD1 GTEMP221))
GTEMP213))
[INCRB NNAM (QUOTE ALGS)
(SETQ GTEMP224 (LIST (QUOTE TYPE)
(QUOTE TRANSFORM)
(QUOTE REDUCING-TO)
BA1
(APPEND (LIST (QUOTE APPLYB)
(KWOTE BA1)
(Q ALGS))
(FIRSTN (SUB1 GTEMP221)
BA-LIST)
[LIST (SETQ GTEMP222 (PACK (LIST (QUOTE BA)
(SMALLER GTEMP219 GTEMP220]
(SETQ GTEMP223 (FIRSTN (ADD1 (IDIFFERENCE (LENGTH GTEMP212)
GTEMP221))
(FNTH BA-LIST GTEMP221]
(COND
([SETQ GTEMP225 (CAR (SOME (RIPPLE BA1 (QUOTE SPEC))
(FUNCTION (LAMBDA (S)
(MEMBER GTEMP224 (GETB S (QUOTE ALGS]
(CPRIN1S 9 CRLF NNAM turned out to be equivalent to GTEMP225 DCR)
(KILB NNAM)
GTEMP225)
(T (SETB NNAM (QUOTE WORTH)
(MAPCAR (GETB BA1 (QUOTE WORTH))
(QUOTE ESUB2)))
(INCRB NNAM (QUOTE GENL)
BA1)
(INCRB BA1 (QUOTE SPEC)
NNAM)
[INCRB NNAM (QUOTE DEFN)
(NCONC1 (ALL-BUT-LAST GTEMP224)
(LIST (QUOTE AND)
[LIST (QUOTE NULL)
(CAR (FNTH BA-LIST (ADD1 (LENGTH (ANY1OFE (GETB NNAM (QUOTE D-R]
(SUBST (QUOTE DEFN)
(QUOTE ALGS)
(LASTELE GTEMP224]
(INCRB NNAM (QUOTE ALGS)
(SUBPAIR (FIRSTN (ADD1 (LENGTH GTEMP223))
(FNTH BA-LIST GTEMP221))
(CONS GTEMP222 GTEMP223)
(CADR (GETB BA1 (QUOTE ALGS)))
T))
(INCRB (QUOTE COALESCE)
(QUOTE EXS)
(LIST BA1 NNAM))
(INCRB NNAM (QUOTE IN-RAN-OF)
(QUOTE COALESCE))
(INCRB BA1 (QUOTE IN-DOM-OF)
(QUOTE COALESCE))
NNAM)))
(T (CPRIN1S 10 CRLF Cannot figure out a way to coalesce the arguments of this operation DCR)
(KILLB NNAM)
NIL])
(BLOWUP-COMPOSE
[LAMBDA (BA1 BA2)
[INCRB GTEMP12 (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE APPLICATION)
(QUOTE OF)
GUP1
(APPEND (LIST (QUOTE APPLYB)
(Q COMPOSE)
(Q ALGS)
(KWOTE BA1)
(KWOTE BA2))
(FIRSTN (LENGTH (CAAR GTEMP11))
BA-LIST]
(COND
([SETQ GTEMP308 (CAR (SOME (ACEX COMPOSE)
(FUNCTION (LAMBDA (C) (* The call on Lastele is because
Compose is an active, so its final
results are the last elements of each of
its examples)
(MEMBER (ANY1OFE (GETB GTEMP12 (QUOTE DEFN)))
(GETB (LASTELE C)
(QUOTE DEFN]
(KILB GTEMP12)
(CPRIN1S 8 GTEMP12 turned out to be equivalent to GTEMP308 DCR)
GTEMP308)
(T (INCRB GUP1 (QUOTE EXS)
(NCONC1 (GEARGS GUP1)
GTEMP12))
[SOME (RIPPLE GUP1 (QUOTE GENL))
(FUNCTION (LAMBDA (G)
(SOME (GETB G (QUOTE D-R))
(FUNCTION (LAMBDA (D)
(AND (ISA BA1 (CAR D))
(ISA BA2 (CADR D))
(INCRB GTEMP12 (QUOTE UP)
(CADDR D))
(INCRB (CADDR D)
(QUOTE EXS)
GTEMP12]
(* This last INCRB says that if an operation f maps onto range C, and we apply f and get a new
Being, then that Being ISA C)
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
(INCRB BA2 (QUOTE IN-DOM-OF)
GUP1)
(INCRB BA1 (QUOTE IN-DOM-OF)
GUP1)
[MAPC [ATOM-INT (DSET-DIFF [APPEND (OR (GETB BA1 (QUOTE GUP))
(GETB BA1 (QUOTE UP)))
(OR (GETB BA2 (QUOTE GUP))
(GETB BA2 (QUOTE UP]
(GETB GTEMP12 (QUOTE UP]
(FUNCTION (LAMBDA (Z)
(COND
((APPLY* (QUOTE DEFN)
Z GTEMP12)
(INCRB Z (QUOTE EXS)
GTEMP12)
(INCRB GTEMP12 (QUOTE UP)
Z] (* We should really repeat this later
on, since many defns involve searchig
for ALGS parts, ...)
(COND
[(GETB GTEMP12 (QUOTE UP))
(SETB GTEMP12 (QUOTE GUP)
(COPY (GETB GTEMP12 (QUOTE UP]
(T (INCRB GTEMP12 (QUOTE UP)
(QUOTE OPERATION))
(INCRB (QUOTE OPERATION)
(QUOTE EXS)
GTEMP12)))
[MAPC GTEMP200 (FUNCTION (LAMBDA (E)
[COND
((AND (NEQ (CADDR E)
GTEMP12)
(ISAG (CAR E)
BA1)
(ISAG (CADR E)
BA2))
(INCRB (CADDR E)
(QUOTE GENL)
GTEMP12)
(INCRB GTEMP12 (QUOTE SPEC)
(CADDR E]
(COND
((AND (NEQ (CADDR E)
GTEMP12)
(ISAS (CAR E)
BA1)
(ISAS (CADR E)
BA2))
(INCRB (CADDR E)
(QUOTE SPEC)
GTEMP12)
(INCRB GTEMP12 (QUOTE GENL)
(CADDR E]
(SETB GTEMP12 (QUOTE D-R)
(CAR GTEMP11))
(INCRB GTEMP12 (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(QUOTE APPLICATION)
(QUOTE OF)
GUP1
(CADR GTEMP11)))
(SETB GTEMP12 (QUOTE WORTH)
(MAP2CAR (GETB BA1 (QUOTE WORTH))
(GETB BA2 (QUOTE WORTH))
(QUOTE TIMES1000)))
GTEMP12])
(BLOWUP-INTERESTING-SPEC
[LAMBDA (BA1 BA2 CBAL)
(CREATEB NEWB)
(INCRB NEWB (QUOTE GENL)
CS-B)
(INCRB CS-B (QUOTE SPEC)
NEWB)
(INCRB NEWB (QUOTE SUGG)
(SUBLIS (LIST (CONS (QUOTE B1)
(KWOTE CS-B))
(CONS (QUOTE B2)
(KWOTE NEWB)))
GSPEC-SUG T)) (* To save about 200 cells, GSPEC-SUG
can be a function which puts together
what is currently the value of that
variable)
(INCRB NEWB (QUOTE SUGG)
(SUBLIS (LIST (CONS (QUOTE B1)
(KWOTE CS-B))
(CONS (QUOTE B2)
(KWOTE NEWB)))
GSPEC2SUG T))
(SETQ GTEMP54 CS-B)
(SETQ CBAL (UNTANGLE-ARGS CS-B GADVISER (GARGS CS-B)))
(SETQ GREM (SIMPLIFY1 (SUBPAIR (SETQ GTEMP55 (GARGS GTEMP54))
CBAL GREM)))
[SETQ GTEMP9 (OUTA (SIMPLIFY1 (SUBPAIR GTEMP55 CBAL (CONS (QUOTE AND)
GTEMP9]
[INCRB NEWB (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE TRANSFORM)
(QUOTE REDUCING-TO)
CS-B
(CONS (QUOTE AND)
(APPEND GTEMP9 (LIST (LIST (QUOTE APPLYB)
(KWOTE CS-B)
(Q DEFN)
(QUOTE BA1)
(QUOTE BA2)
(QUOTE BA3)
(QUOTE BA4]
(SETQ TMP6 0)
(SETB NEWB (QUOTE INT)
(CONS (LIST (QUOTE IMATRIX))
(APPEND GREM)))
[NCONC (CAR (GETB NEWB (QUOTE INT)))
(MAPCAR GREM (FUNCTION (LAMBDA (Z)
(LIST (SETQ TMP6 (ADD1 TMP6]
(SETB NEWB (QUOTE WORTH)
(PROGN [SETQ GTEMP4 (APPEND (GETB CS-B (QUOTE WORTH]
(SET-NTH GTEMP4 1 (AVG2 NEW-ILEV (CAR GTEMP4)))
[COND
((NUMBERP (CAR (FNTH GTEMP4 11)))
(SET-NTH GTEMP4 11 (LIST (QUOTE COND)
(LIST (LIST (QUOTE GETB)
(KWOTE NEWB)
(KWOTE (QUOTE EXS)))
(ADD1 (CAR (FNTH GTEMP4 11]
GTEMP4))
(AND (ISA CS-B (QUOTE ACTIVE))
[SETQ BAL1 (ALL-BUT-LAST (ANY1OFE (GETB CS-B (QUOTE D-R]
(SETQ TMP1
(SELECTQ (LENGTH BAL1)
(0 (CPRIN1S 2 Anyb-exs DOT Fillin2 has come across an active
with no args DOT CRLF CS-B is CS-B DOT NEWB is NEWB CRLF))
(1 (FIL-EX1 BA1 BA2 NEWB))
(2 (FIL-EX2 BA1 BA2 NEWB))
(3 (FIL-EX3 BA1 BA2 NEWB))
(CPRIN1S 2 Sorry DOT ANYB-EXS DOT FILLIN2 has come across an active whose domain CRLF is longer
than 3 components DOT I am not yet implemented
for this DOT I lose DOT CRLF CS-B is CS-B DOT NEWB is NEWB CRLF)))
(INCRB NEWB (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE QUASIRECURSIVE)
(QUOTE CASES)
(QUOTE REDUCING-TO)
CS-B
(CONS (QUOTE COND)
TMP1)))
(INCRB NEWB (QUOTE D-R)
[APPEND (CAR (GETB CS-B (QUOTE D-R] (* NOTE: Later, we must fix this up so
it realy knows what the new D-R is.)
))
(BOOST1 (SUB1 CS-INT)
(QUOTE FILLIN)
NEWB
(QUOTE EXS)
NIL
(SPLIST Any example of NEWB is automatically an interesting example of CS-B))
NEWB])
(BLOWUP-INV
[LAMBDA (BA1 NNAM DOM RAN NDOM NRAN)
(CREATEB NNAM) (* NNAM now names new Being)
[SETQ RAN (LASTELE (ANY1OFE (GETB BA1 (QUOTE D-R] (* RAN holds the range component of the
Active BA1)
[SETQ DOM (ALL-BUT-LAST (ANY1OFE (GETB BA1 (QUOTE D-R] (* DOM now holds a list of the domain
components for BA1)
(SETQ NDOM RAN) (* Actually, if BA1 has only 1 arg
(say, of type A), then NRAN should
simply be a set-of-A's;
use SOFS function)
(SETQ NRAN (QUOTE SET-OF-LISTS))
(INCRB NNAM (QUOTE D-R)
(LIST NDOM NRAN))
(INCRB (QUOTE INVERTED-OP)
(QUOTE EXS)
NNAM)
(INCRB NNAM (QUOTE UP)
(QUOTE INVERTED-OP))
[INCRB NNAM (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE TRANSFORM)
(QUOTE REDUCING-TO)
BA1
(LIST (QUOTE EVERY)
(LIST (QUOTE CDR)
(QUOTE BA2))
(LIST (QUOTE FUNCTION)
(LIST (QUOTE LAMBDA)
(LIST (QUOTE X))
(NCONC1 [CONS (QUOTE AND)
(MAP2CAR [ALL-BUT-LAST (LASTELE (GETB BA1 (QUOTE D-R]
(LIST (QUOTE CADR)
(QUOTE CADDR)
(QUOTE CADDDR)
(QUOTE CADDDDR))
(FUNCTION (LAMBDA (Z1 Z2)
(LIST (QUOTE ISA)
(LIST Z2 (QUOTE X))
(KWOTE Z1]
(NCONC (LIST (QUOTE APPLYB)
(KWOTE BA1)
(Q DEFN))
[FIRSTN (LENGTH DOM)
(LIST (QUOTE (CADR X))
(QUOTE (CADDR X))
(QUOTE (CADDDR X))
(QUOTE (CAR (CDDDDR X]
(LIST (QUOTE BA1]
[INCRB NNAM (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE PC)
(LIST (QUOTE FOREACH)
(QUOTE X)
(QUOTE IN)
(QUOTE BA2)
(CONS BA1 (NCONC1 [FIRSTN (LENGTH DOM)
(LIST (LIST (QUOTE CADR)
(QUOTE X))
(LIST (QUOTE CADDR)
(QUOTE X))
(LIST (QUOTE CADDDR)
(QUOTE X))
(LIST (QUOTE CADDDDR)
(QUOTE X]
(QUOTE BA1]
[INCRB NNAM (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(QUOTE USING)
BA1
(LIST (QUOTE CLASS-IF-NNIL)
(LIST (QUOTE NCONC1)
[LIST (QUOTE BLIND-SEARCH)
CS-INT
(CONS (QUOTE CROSS)
DOM)
(NCONC (LIST (QUOTE APPLYB)
(KWOTE BA1)
(Q DEFN))
(FIRSTN (LENGTH DOM)
(LIST (QUOTE IA1)
(QUOTE IA2)
(QUOTE IA3)
(QUOTE IA4)
(QUOTE IA5)))
(LIST (QUOTE BA1]
(LIST (QUOTE SOMEE)
(LIST (QUOTE ACEX)
BA1)
(Q INV-EX]
(BOOST1 (RMUL CS-INT 3 5)
(QUOTE FILLIN)
NNAM
(QUOTE ALGS)
NIL
(SPLIST Blind search is too slow a way to compute the interesting operation NNAM))
(SETB NNAM (QUOTE WORTH)
(MAPCAR (GETB BA1 (QUOTE WORTH))
(QUOTE ESUB2)))
(INCRB (QUOTE INV-OP)
(QUOTE EXS)
(LIST BA1 NNAM))
(INCRB NNAM (QUOTE IN-RAN-OF)
(QUOTE INV-OP))
(INCRB BA1 (QUOTE IN-DOM-OF)
(QUOTE INV-OP))
NNAM])
(BLOWUP-MAP-JOIN
[LAMBDA (BA1 BA2)
(COND
((NOT (MAP-JOINABLE BA1 BA2))
NIL)
([PROGN [SETQ GUP1 (COND
((ISAG CS-B (QUOTE MAP-JOIN))
CS-B)
(T (QUOTE MAP-JOIN]
(IS-CON (SETQ GTEMP12 (GLUE-IF-ABLE BA1 BA2 (QUOTE MAP-JOIN-)
(QUOTE MJ-] (* Note that we are assuming that there
will not be more than 1 map-joining for
any given pair of operation and
structure)
(INCRB GUP1 (QUOTE EXS)
(NCONC1 (GEARGS GUP1)
GTEMP12))
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
GTEMP12)
((AND MAIN-D-R GTEMP12)
(CREATEB GTEMP12)
(INCRB GTEMP12 (QUOTE GUP)
(QUOTE OPERATION))
(INCRB (QUOTE OPERATION)
(QUOTE EXS)
GTEMP12)
(INCRB GTEMP12 (QUOTE UP)
(QUOTE OPERATION))
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
(INCRB (QUOTE MAP-JOIN)
(QUOTE EXS)
(LIST BA1 BA2 GTEMP12))
(SETB GTEMP12 (QUOTE WORTH)
(MAP2CAR (GETB BA1 (QUOTE WORTH))
(GETB BA2 (QUOTE WORTH))
(QUOTE EAVG2)))
(INCRB GTEMP12 (QUOTE D-R)
(LIST BA1 SYNTH-RANGE))
[INCRB GTEMP12 (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(LIST (QUOTE AND)
(LIST (QUOTE ISA)
(QUOTE BA1)
(KWOTE BA1))
(LIST (QUOTE ISA)
(QUOTE BA2)
(KWOTE SYNTH-RANGE))
(LIST (QUOTE ARE-EQUIV)
(QUOTE BA2)
(LIST (QUOTE APPLYB)
(KWOTE GTEMP12)
(Q ALGS)
(QUOTE BA1]
[INCRB GTEMP12 (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(LIST (QUOTE STRUCHECK)
(LIST (QUOTE CONS)
(LIST (QUOTE CAR)
(QUOTE BA1))
(LIST (QUOTE MAPCONC)
(LIST (QUOTE CDR)
(QUOTE BA1))
(LIST (QUOTE FUNCTION)
(LIST (QUOTE LAMBDA)
(LIST (QUOTE Z))
(LIST (QUOTE APPEND)
(LIST (QUOTE CDR)
(LIST (QUOTE APPLYB)
(KWOTE BA2)
(Q ALGS)
(QUOTE Z]
(INCRB BA1 (QUOTE IN-DOM-OF)
(QUOTE MAP-JOIN))
(INCRB BA2 (QUOTE IN-DOM-OF)
(QUOTE MAP-JOIN))
(CPRIN1 10 CRLF Succeeded EXCLAIM CRLF)
GTEMP12)
(T (KILB GTEMP12)
(CPRIN1S 6 CRLF Failed because (QUOTE I)
could not figure out the domain and range of the new operation GTEMP12 DCR)
(* Note we are tampering with the SUGG
and the WORTH part of this very Being)
(RPLACA (GETB (QUOTE MAP-JOIN)
(QUOTE WORTH))
(RMUL (CAR (GETB (QUOTE MAP-JOIN)
(QUOTE WORTH)))
2 3])
(BLOWUP-MAP-REPLACE
[LAMBDA (BA1 BA2)
(COND
((NOT (MAP-REPLACEABLE BA1 BA2))
NIL)
([PROGN [SETQ GUP1 (COND
((ISAG CS-B (QUOTE MAP-REPLACE))
CS-B)
(T (QUOTE MAP-REPLACE]
(IS-CON (SETQ GTEMP12 (GLUE-IF-ABLE BA1 BA2 (QUOTE MAP-REPLACE-)
(QUOTE MR-] (* Note that we are assuming that there
will not be more than 1 map-replacing
for any given pair of operation and
structure)
(INCRB GUP1 (QUOTE EXS)
(NCONC1 (GEARGS GUP1)
GTEMP12))
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
GTEMP12)
((AND MAIN-D-R SYNTH-RANGE GTEMP12)
(CREATEB GTEMP12)
(INCRB GTEMP12 (QUOTE GUP)
(QUOTE OPERATION))
(INCRB (QUOTE OPERATION)
(QUOTE EXS)
GTEMP12)
(INCRB GTEMP12 (QUOTE UP)
(QUOTE OPERATION))
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
(INCRB (QUOTE MAP-REPLACE)
(QUOTE EXS)
(LIST BA1 BA2 GTEMP12))
(SETB GTEMP12 (QUOTE WORTH)
(MAP2CAR (GETB BA1 (QUOTE WORTH))
(GETB BA2 (QUOTE WORTH))
(QUOTE EAVG2)))
(INCRB GTEMP12 (QUOTE D-R)
(LIST BA1 SYNTH-RANGE))
[INCRB GTEMP12 (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(LIST (QUOTE AND)
(LIST (QUOTE ISA)
(QUOTE BA1)
(KWOTE BA1))
(LIST (QUOTE ISA)
(QUOTE BA2)
(KWOTE SYNTH-RANGE))
(LIST (QUOTE ARE-EQUIV)
(QUOTE BA3)
(LIST (QUOTE APPLYB)
(KWOTE GTEMP12)
(Q ALGS)
(QUOTE BA1)
(QUOTE BA2]
[INCRB GTEMP12 (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(LIST (QUOTE CONS)
(LIST (QUOTE CAR)
(QUOTE BA1))
(LIST (QUOTE MAPCAR)
(LIST (QUOTE CDR)
(QUOTE BA1))
(LIST (QUOTE FUNCTION)
(LIST (QUOTE LAMBDA)
(LIST (QUOTE Z))
(LIST (QUOTE APPLYB)
(KWOTE BA2)
(Q ALGS)
(QUOTE Z]
(INCRB BA1 (QUOTE IN-DOM-OF)
(QUOTE MAP-REPLACE))
(INCRB BA2 (QUOTE IN-DOM-OF)
(QUOTE MAP-REPLACE))
(CPRIN1 10 CRLF Succeeded EXCLAIM CRLF)
GTEMP12)
(T (KILB GTEMP12)
(CPRIN1S 6 CRLF Failed because (QUOTE I)
could not figure out the domain and range of the new operation GTEMP12 DCR)
(* Note we are tampering with the SUGG
and the WORTH part of this very Being)
(RPLACA (GETB (QUOTE MAP-REPLACE)
(QUOTE WORTH))
(RMUL (CAR (GETB (QUOTE MAP-REPLACE)
(QUOTE WORTH)))
2 3])
(BLOWUP-MAP-REPLACE2
[LAMBDA (BA1 BA2 BA3)
(COND
((NOT (MAP-REPLACE2ABLE BA1 BA2 BA3))
NIL)
([PROGN [SETQ GUP1 (COND
((ISAG CS-B (QUOTE MAP-REPLACE2))
CS-B)
(T (QUOTE MAP-REPLACE2]
(IS-CON (SETQ GTEMP12 (GLUE-IF-ABLE BA1 (GLUE BA2 BA3)
(QUOTE MAP-REPLACE2-)
(QUOTE MR2-] (* Note that we are assuming that there
will not be more than 1 map-replacing
for any given pair of operation and
structure)
(INCRB GUP1 (QUOTE EXS)
(NCONC1 (GEARGS GUP1)
GTEMP12))
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
GTEMP12)
((AND MAIN-D-R SYNTH-RANGE GTEMP12)
(CREATEB GTEMP12)
(INCRB GTEMP12 (QUOTE GUP)
(QUOTE OPERATION))
(INCRB (QUOTE OPERATION)
(QUOTE EXS)
GTEMP12)
(INCRB GTEMP12 (QUOTE UP)
(QUOTE OPERATION))
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
(INCRB (QUOTE MAP-REPLACE2)
(QUOTE EXS)
(LIST BA1 BA2 BA3 GTEMP12))
(SETB GTEMP12 (QUOTE WORTH)
(MAP2CAR (GETB BA1 (QUOTE WORTH))
(GETB BA3 (QUOTE WORTH))
(QUOTE EAVG2)))
(INCRB GTEMP12 (QUOTE D-R)
(LIST BA1 BA2 SYNTH-RANGE))
[INCRB GTEMP12 (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(LIST (QUOTE AND)
(LIST (QUOTE ISA)
(QUOTE BA2)
(KWOTE BA2))
(LIST (QUOTE ISA)
(QUOTE BA1)
(KWOTE BA1))
(LIST (QUOTE ISA)
(QUOTE BA3)
(KWOTE SYNTH-RANGE))
(LIST (QUOTE ARE-EQUIV)
(QUOTE BA4)
(LIST (QUOTE APPLYB)
(KWOTE GTEMP12)
(Q ALGS)
(QUOTE BA1)
(QUOTE BA2)
(QUOTE BA3]
[INCRB GTEMP12 (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(LIST (QUOTE CONS)
(LIST (QUOTE CAR)
(QUOTE BA1))
(LIST (QUOTE MAPCAR)
(LIST (QUOTE CDR)
(QUOTE BA1))
(LIST (QUOTE FUNCTION)
(LIST (QUOTE LAMBDA)
(LIST (QUOTE Z))
(LIST (QUOTE APPLYB)
(KWOTE BA3)
(Q ALGS)
(QUOTE Z)
(QUOTE BA2]
(INCRB BA1 (QUOTE IN-DOM-OF)
(QUOTE MAP-REPLACE2))
(INCRB BA2 (QUOTE IN-DOM-OF)
(QUOTE MAP-REPLACE2))
(INCRB BA3 (QUOTE IN-DOM-OF)
(QUOTE MAP-REPLACE2))
(CPRIN1 10 CRLF Succeeded EXCLAIM CRLF)
GTEMP12)
(T (KILB GTEMP12)
(CPRIN1S 6 CRLF Failed because (QUOTE I)
could not figure out the domain and range for GTEMP12 DCR) (* Note we are tampering with the SUGG
and the WORTH part of this very Being)
(RPLACA (GETB (QUOTE MAP-REPLACE2)
(QUOTE WORTH))
(RMUL (CAR (GETB (QUOTE MAP-REPLACE2)
(QUOTE WORTH)))
2 3])
(BLOWUP-NEW-SPEC
[LAMBDA (NDEF NINT ND1) (* Create a new specialization of CS-B,
whose defn is NDEF and whose int is now
NINT)
(SETQ ND1 (LASTELE NDEF))
(SETQ NDEF (NCONC (LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(QUOTE SIMILAR-TO)
CS-B
(QUOTE WHICH-IS))
NDEF))
(COND
([SETQ NEWB (CAR (SOME (APPLY* (QUOTE SPEC)
CS-B)
(FUNCTION (LAMBDA (S)
(SOME (GETB S (QUOTE DEFN))
(FUNCTION (LAMBDA (D)
(EQUAL (LASTELE D)
ND1] (* Actually, a mopre sophisticated equiv
check might be in order here)
(CPRIN1S 6 CRLF Unfortunately COMMA the suggested specialization already exists COMMA namely
in the concepts called NEWB DCR)
NEWB)
((SETQ NEWB (NEWNAME (GLUE (QUOTE SPEC)
CS-B)))
(CREATEB NEWB)
(INCRB NEWB (QUOTE GENL)
CS-B)
(INCRB CS-B (QUOTE SPEC)
NEWB)
(INCRB NEWB (QUOTE DEFN)
NDEF)
(SETB NEWB (QUOTE WORTH)
(PROGN [SETQ GTEMP4 (APPEND (GETB CS-B (QUOTE WORTH]
(SET-NTH GTEMP4 2 (AVG2 NEW-ILEV (CAR GTEMP4)))
(SET-NTH GTEMP4 1 NINT)
[COND
((NUMBERP (CAR (FNTH GTEMP4 11)))
(SET-NTH GTEMP4 11 (LIST (QUOTE COND)
(LIST (LIST (QUOTE GETB)
(KWOTE NEWB)
(KWOTE (QUOTE EXS)))
(ADD1 (CAR (FNTH GTEMP4 11]
GTEMP4))
[COND
((ISA CS-B (QUOTE ACTIVE))
[INCRB NEWB (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE QUASIRECURSIVE)
(QUOTE CASES)
(QUOTE REDUCING-TO)
CS-B
(NCONC (LIST (QUOTE APPLYB)
(KWOTE CS-B)
(Q ALGS))
(GARGS CS-B]
(INCRB NEWB (QUOTE D-R)
[APPEND (CAR (GETB CS-B (QUOTE D-R] (* NOTE: Later, we must fix this up so
it realy knows what the new D-R is.)
]
(BOOST1 (RMUL CS-INT 3 7)
(QUOTE FILLIN)
NEWB
(QUOTE EXS)
NIL
(SPLIST NEWB is a recent concept COLON keep focus of attention))
NEWB])
(BLOWUP-RESTRIC
[LAMBDA (BA1 BA2 BA3)
(COND
([NOT (AND (ISA BA1 (QUOTE ACTIVE))
(OR (ISA BA2 (QUOTE ANY-STRUC))
(ISAG BA2 (QUOTE OBJECT)))
(COND
((NULL BA3)
(DEDUCE-RPART BA1 BA2))
((ISA BA3 (QUOTE ACTIVE)) (* Then all we must do is confirm or
deny that BA3 is the desired
restriction)
(SETQ GTEMP12 (CHECK-RES BA1 BA2 BA3)))
((FMEMB BA3 POSS-RPARTS) (* Then we must find the restriction,
but we have been told what part of the
BA1 operation is to be modified)
(SETQ GRPART BA3)
(SETQ BA3 NIL)
(CONFIRM-RPART BA1 BA2 GRPART))
(T (* I will assume that this is an
erroroneous instantiation of BA3)
(CPRIN1S 0 CRLF Erroneous instantiation of (QUOTE BA3) as BA3 in Restrict DCR CRLF)
(SETQ BA3 NIL)
(DEDUCE-RPART BA1 BA2] (* Checking the arguments: a function, a
structure, the restriction of that
function function to that structure
(if unspecified, this is what we
compute))
NIL)
([IS-CON (SETQ GTEMP12 (GLUE-IF-ABLE BA1 BA2 (QUOTE RESTRICT-)
(QUOTE RES-] (* Note that we are assuming that there
will not be more than 1 restriction for
any given pair of operation and
structure)
[SETQ GUP1 (COND
((ISAG CS-B (QUOTE RESTRICT))
CS-B)
(T (QUOTE RESTRICT]
(INCRB GUP1 (QUOTE EXS)
(NCONC1 (GEARGS GUP1)
GTEMP12))
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
GTEMP12)
([SETQ GTEMP11 (SOME [SETQ GTEMP200 (NCONC (MAPCAR (EXS-BDY RESTRICT)
(QUOTE LASTELE))
(MAPCAR (EXS RESTRICT)
(QUOTE LASTELE]
(FUNCTION (LAMBDA (Z)
(SOME (GETB Z (QUOTE DEFN))
(FUNCTION (LAMBDA (D)
(MATCH D WITH ('TYPE 'APPLICATION 'OF & ('APPLYB ('QUOTE 'RESTRICT)
('QUOTE 'ALGS)
('QUOTE =BA1)
('QUOTE =BA2)
$]
(SETQ GTEMP12 (CAR GTEMP11)))
((AND GRPART GRCOMP GTEMP12)
[SETQ GUP1 (COND
((ISAG CS-B (QUOTE RESTRICT))
CS-B)
(T (QUOTE RESTRICT]
(CREATEB GTEMP12)
(INCRB GTEMP12 (QUOTE GENL)
BA1)
(INCRB BA1 (QUOTE SPEC)
GTEMP12)
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
(INCRB GUP1 (QUOTE EXS)
(LIST BA1 BA2 GTEMP12))
(SETB GTEMP12 (QUOTE WORTH)
(MAP2CAR (GETB BA1 (QUOTE WORTH))
(GETB BA2 (QUOTE WORTH))
(QUOTE EAVG2)))
(GS-CHECK GTEMP12)
[INCRB GTEMP12 (QUOTE D-R)
(APPEND (ANY1OFE (GETB BA1 (QUOTE D-R]
[INCRB GTEMP12 (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(QUOTE REDUCING-TO)
BA1
(LIST (QUOTE AND)
(QUOTE NEW-CONDS)
(NCONC (LIST (QUOTE APPLYB)
(KWOTE BA1)
(Q DEFN))
(GARGS BA1]
[INCRB GTEMP12 (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(QUOTE SLOW)
(LIST (QUOTE AND)
(LIST (QUOTE SETQ)
(QUOTE BA5)
(NCONC (LIST (QUOTE APPLYB)
(KWOTE BA1)
(Q ALGS))
(GARGS BA1)))
(QUOTE NEW-CONDS)
(QUOTE BA5]
(INCRB BA1 (QUOTE IN-DOM-OF)
(QUOTE RESTRICT))
(INCRB BA2 (QUOTE IN-DOM-OF)
(QUOTE RESTRICT))
(COND
[[OR (EQ GRPART (QUOTE RANGE))
(AND (EQ GRPART (QUOTE DOMAIN))
(EQ GRCOMP (LASTELE (ANY1OFE (GETB GTEMP12 (QUOTE D-R]
(DSUBST BA2 GRCOMP (GETB GTEMP12 (QUOTE D-R)))
(DSUBST (LIST (QUOTE APPLY*)
(Q DEFN)
(KWOTE BA2)
(QUOTE BA5))
(QUOTE NEW-CONDS)
(GETB GTEMP12 (QUOTE ALGS)))
(DSUBST (LIST (QUOTE APPLY*)
(Q DEFN)
(KWOTE BA2)
(QUOTE BA5))
(QUOTE NEW-CONDS)
(GETB GTEMP12 (QUOTE DEFN]
[(EQ GRPART (QUOTE DOMAIN))
(DSUBST BA2 GRCOMP (GETB GTEMP12 (QUOTE D-R)))
(DSUBST (LIST (QUOTE ISA)
(QUOTE BA1)
(KWOTE BA2))
(QUOTE NEW-CONDS)
(GETB GTEMP12 (QUOTE ALGS)))
(DSUBST (LIST (QUOTE ISA)
(QUOTE BA1)
(KWOTE BA2))
(QUOTE NEW-CONDS)
(GETB GTEMP12 (QUOTE DEFN]
((EQ GRPART (QUOTE DEFN)) (* I am unsure how to do this;
wait for specific needs and then fill
this in)
(NOTINYET))
(T (CPRIN1S 7 Unusual Grpart COLON GRPART in Restrict DCR)))
(CPRIN1 9 CRLF Succeeded EXCLAIM CRLF)
GTEMP12)
(T (KILB GTEMP12)
(CPRIN1 6 CRLF Failed DCR) (* Note we are tampering with the SUGG
and the WORTH part of this very Being)
(RPLACA (GETB (QUOTE RESTRICT)
(QUOTE WORTH))
(RMUL (CAR (GETB (QUOTE RESTRICT)
(QUOTE WORTH)))
2 3])
(BOOST
[LAMBDA (OP B P A W)
(ADD1CAND (NCONC (LIST OP B P)
A)
CS-INT W)
NIL])
(BOOST1
[LAMBDA (I OP B P A W)
(ADD1CAND (NCONC (LIST OP B P)
A)
I W)
NIL])
(BPFS
[LAMBDA (B)
(CDDR (CADDR (GETD B])
(BRIEF-U
[LAMBDA NIL
(SELECTQ ESTAT
(0 (CPRIN1 0 CRLF FIRSTNAME COMMA "you have never used this system before" DCR
"Here are some basic things you should know:" CRLF)
(BRIEFULL))
(1 (CPRIN1 0 CRLF FIRSTNAME COMMA "you have used AM once before" DCR
"Do you feel like you need some refreshing about how to work with it? ")
(SELECTQ (RATOM)
((Y y YES yes)
(SETQ ESTAT 0)
(BRIEFULL))
(BRIEFLITE)))
(2 (CPRIN1 0 CRLF FIRSTNAME COMMA "you are a two-time user" DCR "Do you want a review? ")
(SELECTQ (RATOM)
((Y YES y yes)
(SETQ ESTAT 1)
(BRIEFLITE))
(BRIEFNOT)))
(BRIEFNOT])
(BRIEFLITE
[LAMBDA NIL
(CPRIN1S 0 CRLF CRLF TAB DISCLAIMER COLON The user interface is still unfinished COMMA and
in fact the only polished part is the following message describing it EXCLAIM Try it at your own risk EXCLAIM
CRLF CRLF)
(CPRIN1S 0 CRLF TAB You COMMA FIRSTNAME COMMA can affect this concept growing process DCR At any time COMMA you may
hit ↑I COMMA which will Interrupt me DCR Once interrupted COMMA I will answer one question
or perform one task SEMICOLON CRLF a typical question I can answer is WHY SEMICOLON CRLF a typical task
is LPAREN Raise the Interest Level
of the Frobnate Concept RPAREN DCR)
(CPRIN1S 0 TAB A second way to interact with me is to help me decide CRLF which Cand to
do next each time DOT You can see my top choices COMMA their CRLF reasons COMMA and overrule me
if you want DOT The variable Seencands is CRLF the number
of Candidates you see each time COMMA and Ucontrol indicates CRLF the amount
of control you have over my choosing DCR)
(CPRIN1S 0 CRLF TAB To keep you informed COMMA I will periodically print out messages DCR The level
of verbosity can be changed by interrupting me DCR)
(BRIEFNOT])
(BRIEFNOT
[LAMBDA NIL
(CPRIN1 0 CRLF TAB "More details can be obtained when you interrupt with ↑I" DCR CRLF])
(BRIEFULL
[LAMBDA NIL
(CPRIN1S 0 TAB AM has (LENGTH CONCEPTS)
concepts to start with COMMA each with only CRLF about 5 of its potential 30 facets LPAREN parts RPAREN
filled
in DCR)
(CPRIN1S 0 TAB Repeatedly COMMA AM selects a part of a concept COMMA CRLF and tries to fill it
in or check it DOT In this process COMMA new CRLF concepts may emerge and be granted full status SEMICOLON
in those cases COMMA CRLF almost all their parts will be empty at the time of their creation DCR CRLF TAB)
(CPRIN1S 0 (QUOTE CANDS)
is a list of suggested future activities for AM DCR Repeatedly COMMA AM picks a Candidate
from (QUOTE CANDS) and does what it says DCR A typical Cand might be COLON CRLF TAB TAB LPAREN Fill
in examples of interesting compositions RPAREN DCR TAB)
(CPRIN1S 0 Each Cand also has a list
of reasons explaining why it was CRLF proposed COMMA and a numeric rating of its overall value DCR CRLF TAB)
(CPRIN1S 0 DO-THRESHhold is a numeric variable that indicates the lowest CRLF rating a Cand may have
and still be executed by AM DCR If no Cand on (QUOTE CANDS)
oeasures up COMMA
then all the concepts try
to suggest new candidates COMMA which are merged into (QUOTE CANDS)
DCR TAB)
(BRIEFLITE])
(CADDDDR
[LAMBDA (L)
(CAR (CDDDDR L])
(CAN-BE-1-STYPE
[LAMBDA (P1 E NE E1 NE1 E2 NE2)
(* Can there be a single, unique type of structure that P1 operates on? That is, does P1 give
different values depending on the TYPE of structure it is given?)
(COND
([NOT (AND [SETQ E (OR (RAND-MEMB (GETB P1 (QUOTE EXS-BDY)))
(RAND-MEMB (GETB P1 (QUOTE EXS]
[SETQ NE (OR (RAND-MEMB (GETB P1 (QUOTE EXS-NOT-BDY)))
(RAND-MEMB (GETB P1 (QUOTE EXS-NOT]
(SETQ E1 (CAR E))
(SETQ NE1 (CAR NE))
(SETQ E2 (CADR E))
(SETQ NE2 (CADR NE] (* Inconclusive)
NIL)
([AND [EVERY GSTL (FUNCTION (LAMBDA (S1 SE1)
(SETQ SE1 (RPLACA E1 S1))
(EVERY GSTL (FUNCTION (LAMBDA (S2)
(APPLYB P1 (QUOTE ALGS)
SE1
(RPLACA E2 S2]
(NOTANY GSTL (FUNCTION (LAMBDA (NS1 NSE1)
(SETQ NSE1 (RPLACA NE1 NS1))
(SOME GSTL (FUNCTION (LAMBDA (NS2)
(APPLYB P1 (QUOTE ALGS)
NSE1
(RPLACA NE2 NS2]
(CPRIN1S 9 CRLF Experiments indicate that P1 is not affected
by varying the type of structure of its arguments DCR)
(CPRIN1S 10 TAB So a single canonical structure-type can be chosen DCR)
T)
(T (* The presence of multiple-eles
definitely affects the result of P1)
(CPRIN1S 9 CRLF Experiments indicate that P1 is affected
by the varying the type of structure of its arguments DCR)
(CPRIN1S 10 TAB So no single type of structure can be dictated as the canonical type DCR)
NIL])
(CANON-SUG
[LAMBDA NIL
(MAPCONC (ACEX PREDICATE)
(FUNCTION (LAMBDA (PE PSP PQUO PSP1 PDR) (* The following may need to be
drastically revised; e.g., when the new
RECORD-package form of WORTH is finally
implemented)
(AND (SETQ PSP (GETB PE (QUOTE SPEC)))
(GETB-OR PE (QUOTE EXS)
(QUOTE EXS-BDY))
(GETB-OR PE (QUOTE EXS-NOT-BDY)
(QUOTE EXS-NOT))
(ILESSP [SETQ PQUO (FQUOTIENT [IPLUS (LENGTH (GETB PE (QUOTE EXS)))
(LENGTH (GETB PE (QUOTE EXS-BDY]
(IPLUS (LENGTH (GETB PE (QUOTE EXS-NOT)))
(LENGTH (GETB PE (QUOTE EXS-NOT-BDY]
5)
(GREATERP PQUO .1)
(NOTANY (GETB (QUOTE CANONIZE)
(QUOTE EXS))
(QUOTE EQPE))
(NOTANY (GETB (QUOTE CANONIZE)
(QUOTE EXS-NOT))
(QUOTE EQPE))
(NOTANY (GETB (QUOTE CANONIZE)
(QUOTE EXS-NOT-BDY))
(QUOTE EQPE))
(NOTANY (GETB (QUOTE CANONIZE)
(QUOTE EXS-BDY))
(QUOTE EQPE))
[SETQ PDR (ANY1OFE (GETB PE (QUOTE D-R]
[SETQ PSP1 (CAR (SOME PSP (FUNCTION (LAMBDA (S)
(AND (EQUAL (ANY1OFE (GETB S (QUOTE D-R)))
PDR)
(NOTANY (GETB (QUOTE RESTRICT)
(QUOTE EXS))
(FUNCTION (LAMBDA (R)
(AND (EQ PE (CAR R))
(EQ S (CADDR R]
(LIST (LIST (LIST (QUOTE APPLYB)
(Q CANONIZE)
(Q ALGS)
(KWOTE PE)
(KWOTE PSP1))
(SMALLER 1000 (DOTPROD (LIST CS-INT INTHRESH DO-THRESH (SMALLER 0 (DIFFERENCE PQUO .3)
)
(LARGER 0 (DIFFERENCE PQUO .3)))
(LIST (FPLUS .6 (FQUOTIENT 22.0 (CAR (GETB (QUOTE CANONIZE)
(QUOTE WORTH)))
(* Notice that this calls on the Worth
components of this Being)
(* Note: either the factor must be about 20, or else it can be about 3 and some new 2nd reason for
canonizing will shoot it up later, e.g., discovering that multiplication somehow relates equality
and equivalence)
))
.2 .1 40.0 20.0)))
(LIST (SPLIST It would be nice to find a canonical LPAREN with respect
to (ENGN PE) and (ENGN PSP1)
RPAREN representation (QUOTE C)
for any (CINL (MAPCAR (ATOM-INT (ALL-BUT-LAST PDR))
(QUOTE ENGN)))
(QUOTE X)
SEMICOLON that is COMMA CRLF LPAREN (@ PE)
x y RPAREN iff CRLF LPAREN (@ PSP1)
LPAREN
(QUOTE C)
x RPAREN SPACE LPAREN (QUOTE C)
y RPAREN RPAREN DCR])
(CAVG
[LAMBDA (X Y)
(COND
((OR (MINUSP X)
(MINUSP Y))
(IPLUS X Y))
(T (SMALLER 1000 (FIX (SQRT (IPLUS (ITIMES X X)
(ITIMES Y Y])
(CHECK-RES
[LAMBDA (F1 S F2) (* Check that F2 is in fact a restricted
specialization of F1, restricted to S in
some way)
(NOTINYET])
(CINL
[LAMBDA (L)
(COND
((NLISTP L)
L)
((CDR L)
L)
(T (CAR L])
(CLASS
[NLAMBDA X
(CONS (QUOTE CLASS)
X])
(CLASS-IF-NNIL
[LAMBDA (Z)
(COND
[(AND (LISTP Z)
(DREMOVE NIL Z))
(CONS (QUOTE CLASS)
(SORT (SELF-INT Z)
(QUOTE SORD]
((AND Z (ATOM Z))
(LIST (QUOTE CLASS)
Z])
(COMMENT
[NLAMBDA X
(CONS (QUOTE COMMENT)
X])
(CON-MERGE-ARGS
[LAMBDA (F1 F2 F12 PGM1 SCHK SAPL DOM1 DOM2 RAN1 RAN2 TIL DOM3)
[SETQ RAN1 (LAST (CAR (GETB F1 (QUOTE D-R]
(SETQ DOM1 (LDIFF (CAR (GETB F1 (QUOTE D-R)))
RAN1))
[SETQ RAN2 (LAST (CAR (GETB F2 (QUOTE D-R]
(SETQ DOM2 (LDIFF (CAR (GETB F2 (QUOTE D-R)))
RAN2))
(* SETQ DOM3 (AND (CDR DOM1)
(LIST (CADR (MIN2 (APPEND RAN2 RAN2 RAN2 RAN2) DOM1
(QUOTE FRAC-INCLU))))))
(COMMENT
AS DOMi AND RANi ARE LOCATED, SWITCHING
OF ARGS MAY BE REQUIRED, INSIDE PGM1)
(* AND (MEMB
(CAR DOM3) DOM2)
(SETQ DOM3 NIL))
(SETQ GTEMP20 (LENGTH DOM2))
[SETQ SAPL
(NCONC
(LIST (QUOTE APPLYB)
(KWOTE F1)
(Q ALGS))
(MAPCAR
(SUB-ONCE
(QUOTE X)
[SETQ GTEMP19
(COND
((IS-ONE-OF (CAR RAN2)
DOM1))
[(SETQ SCHK (ONE-ISAG DOM1 (CAR RAN2]
((SETQ SCHK
(AND (SETQ TIL (APPLY* (QUOTE ACEX)
(CAR RAN2)))
(CAR (SOME DOM1
(FUNCTION (LAMBDA (D)
(INTERSECTION
TIL
(APPLY* (QUOTE ACEX)
D]
DOM1
(* Notice that we really should be able to subst X
for any suitable member of DOM1, regardless of
position. Sometimes, this would mean suggesting that
new Beings be created.)
(* Actually, a 3rd possibility in the above COND,
which would also trigger SCHK, is if there is any
knwon/provable intersection between exs of
(CAR RAN2) and rxs of some member of DOM1)
(* A 4th possibility is: if there exists a canonical
bijection between (CAR RAN2) and a member of DOM1,
then apply this to "buffer" the result of f2, just
before applying f1 to that result)
)
(FUNCTION (LAMBDA (Z)
(COND
((EQ Z (QUOTE X))
(QUOTE X))
(T (SETQ GTEMP20 (ADD1 GTEMP20))
(CAR (FNTH BA-LIST GTEMP20]
(* SCHK is a flag which means that f2 maps us into
an element of RAN2 which is not guaranteed a priori
to be an element of DOM1, hence a check for this
applicability of f1 will then have to be made)
(COND
((FMEMB (QUOTE X)
SAPL)
(SETQ DOM3 (REM-ONCE GTEMP19 DOM1))
(SETQ GTEMP7 (APPEND DOM3 DOM2))
[COND
[(NEQ (LENGTH GTEMP7)
(LENGTH (SELF-INT GTEMP7)))
(CPRIN1S 9 CRLF CRLF AM can later coalesce the D-R
of F12 DCR)
[ADD-CANDS
(LIST
(LIST (LIST (QUOTE APPLYB)
(Q COALESCE)
(Q ALGS)
(KWOTE F12))
(IPLUS 100
(IQUOTIENT
(DOTPROD (FIRSTN 2 (GETB F1
(QUOTE WORTH)))
(GETB F2 (QUOTE WORTH)))
2000))
(LIST (SPLIST There is an overlap
in the new combined domain
of the operation F12]
(SWHY 9 (There is an obvious overlap in (@ GTEMP7)
,the new combined
domain
of (@ F12]
([SOME GTEMP7 (FUNCTION (LAMBDA (X)
(IS-ONE-OF X (CDR (FMEMB X GTEMP7]
(CPRIN1S 10 CRLF CRLF AM may later coalesce the D-R
of F12 DCR)
[ADD-CANDS
(LIST (LIST (LIST (QUOTE APPLYB)
(Q COALESCE)
(Q ALGS)
(KWOTE F12))
(IQUOTIENT (DOTPROD
(FIRSTN 2 (GETB F1 (QUOTE WORTH))
)
(GETB F2 (QUOTE WORTH)))
2500)
(LIST (SPLIST There may be an overlap
in the new combined domain
of the operation F12]
(SWHY 10 (There is a subtle overlap in (@ GTEMP7)
,the new combined
domain
of (@ F12]
[SETQ PGM1 (LIST (QUOTE PROG)
(LIST (QUOTE X))
[LIST (QUOTE SETQ)
(QUOTE X)
(NCONC (LIST (QUOTE APPLYB)
(KWOTE F2)
(Q ALGS))
(FIRSTN (LENGTH DOM2)
(LIST (QUOTE BA1)
(QUOTE BA2)
(QUOTE BA3]
(LIST (QUOTE RETURN)
(COND
(SCHK (LIST (QUOTE AND)
(LIST (QUOTE APPLY*)
(Q DEFN)
(KWOTE SCHK)
(QUOTE X))
SAPL))
(T (LIST (QUOTE AND)
(QUOTE X)
SAPL]
(LIST (LIST (APPEND DOM2 DOM3 RAN1))
PGM1))
(T (* Composing is not
possible)
NIL])
(CONFIRM-RPART
[LAMBDA (F S P DOM RAN) (* Check that the P part of F can be
restricted in some way to S)
(* Also, set the value of GRCOMP, the
compnent of F.P that "matches")
[SETQ RAN (LASTELE (ANY1OFE (GETB F (QUOTE D-R]
[SETQ DOM (ALL-BUT-LAST (ANY1OFE (GETB F (QUOTE D-R]
(SELECTQ P
[RANGE (SETQ GRCOMP (COND
((EQ S RAN)
NIL)
((ISAG S RAN)
T)
((ISAS RAN S)
T)
((SETQ GTEMP318 (INTERSECTION (APPLY* (QUOTE ACEX)
RAN)
(APPLY* (QUOTE ACEX)
S)))
(* AM should now use the relative sizes the 2 sets and their intersection to carefully judge whether
or not S can safely be called a restriction of RAN;
perhaps experiment to see if exs of S also satisfy RAN;
f so, conjecture that S is a specialization of RAN)
(* But for now, just assume it is OK)
T]
[DOMAIN (SETQ GRCOMP (CAR (SOME DOM (FUNCTION (LAMBDA (D1)
(COND
((EQ S D1)
NIL)
((ISAG S D1)
T)
((ISAS D1 S)
T)
((SETQ GTEMP318 (INTERSECTION (APPLY* (QUOTE ACEX)
D1)
(APPLY* (QUOTE ACEX)
S)))
(* AM should now use the relative sizes the 2 sets and their intersection to carefully judge whether
or not S can safely be called a restriction of RAN;
perhaps experiment to see if exs of S also satisfy RAN;
f so, conjecture that S is a specialization of D1)
(* But for now, just assume it is OK)
T]
[DEFN (SETQ GRCOMP (CAR (SOME (GETB F (QUOTE DEFN))
(FUNCTION (LAMBDA (D1) (* Somehow, see if we can use S to
restrict this defn D1 of F)
NIL]
NIL])
(CONSTANTT
[LAMBDA NIL T])
(CONTRAST-DEFNS
[LAMBDA (P Q)
(OR [CDR (FASSOC (QUOTE DEFN)
(FASSOC Q (GETB P (QUOTE TIES]
(SOME (GETB P (QUOTE DEFN))
(FUNCTION (LAMBDA (D1) (* Worry about this when we first ever
use it)
NIL])
(CPRIN1
[NLAMBDA CPARG
(COND
((IGREATERP VERBOSITY (EVAL (CAR CPARG)))
(MAPC (CDR CPARG)
(FUNCTION (LAMBDA (CPZX)
(COND
((STRINGP CPZX)
(PRIN1 CPZX))
((FMEMB CPZX PUNC)
(PRIN1 (GETTOPVAL CPZX)))
((LISTP CPZX)
(PRIN1 (EVAL CPZX)))
((NEQ (GETTOPVAL CPZX)
(QUOTE NOBIND))
(PRIN1 (EVAL CPZX)))
((NEQ (EVALV CPZX)
(QUOTE NOBIND))
(PRIN1 (EVALV CPZX)))
(T (PRIN1 CPZX])
(CPRIN1S
[NLAMBDA CPARG
(COND
((IGREATERP VERBOSITY (EVAL (CAR CPARG)))
(MAPC (CDR CPARG)
(FUNCTION (LAMBDA (CPZX)
(COND
[(NEQ (GETTOPVAL CPZX)
(QUOTE NOBIND))
(COND
((FMEMB CPZX PUNC)
(PRIN1 (GETTOPVAL CPZX)))
(T (PRIN1 SPACE)
(PRIN1 (EVAL CPZX]
((NEQ (EVALV CPZX)
(QUOTE NOBIND))
(PRIN1 SPACE)
(PRIN1 (EVALV CPZX)))
(T (SETTOPVAL CPZX CPZX)
(PRIN1 SPACE)
(PRIN1 CPZX])
(CR-INVERT
[LAMBDA (CR CC)
[MAP2C BA-LIST [ALL-BUT-LAST (CAR (GETB CS-B (QUOTE D-R]
(FUNCTION (LAMBDA (BA B)
(SET BA (RAND-MEMB (APPLY* (QUOTE ACEX)
B]
(SET CR (EVAL CC))
(SETQ GTEMP132 (MAPCAR (GARGS CS-B)
(QUOTE EVAL)))
(SETQ GTEMP133 (APPLYB CS-B (QUOTE DEFN)
BA1 BA2 BA3 BA4))
(COND
(GTEMP133 (LIST (NCONC1 GTEMP132 GTEMP133])
(CREATEB
[LAMBDA (B PFLG)
(COND
((IS-CON B))
(T (COND
(PFLG (NCONC1 CONCEPTS B))
(T (ATTACH B CONCEPTS)))
(PUTHASH B B HCON)
(SETQ FIXEDCONS (UNION (LIST B)
FIXEDCONS))
(* Note we are definitely NOT assigning B a value. The function RESET3 can thus distinguish the
original Beings from those fabricated by the rest of the system.)
(PUTD B (COPY TRIVB))
(SETB B (QUOTE WORTH)
(LIST 0))
B])
(DE-THRESH
[LAMBDA NIL
(CPRIN1S 6 Do-thresh reduced)
(CPRIN1S 8 from DO-THRESH)
(SETQ DO-THRESH (IQUOTIENT (ITIMES DO-THRESH 2)
3))
(CPRIN1S 7 to DO-THRESH)
DO-THRESH])
(DECRB
[LAMBDA (B P X)
(AND (IS-CON B)
(FMEMB P FACETS)
(OR (DREMOVE X (GETB B P))
(REMPROP B P])
(DEDUCE-CANON
[LAMBDA (P1 P2 N A D PGM1)
(CREATEB N)
[SETQ GUP1 (COND
((ISAG CS-B (QUOTE CANONIZE))
CS-B)
(T (QUOTE CANONIZE]
[INCRB N (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE QUASIRECURSIVE)
(QUOTE SELF)
(LIST (QUOTE AND)
(LIST (QUOTE ISA)
(QUOTE BA1)
(KWOTE A))
(LIST (QUOTE EQUAL)
(QUOTE BA2)
(LIST (QUOTE APPLYB)
(KWOTE N)
(Q ALGS)
(QUOTE BA1]
[INCRB N (QUOTE DEFN)
(LIST (QUOTE TYPE)
(QUOTE APPLICATION)
(QUOTE OF)
GUP1
(LIST (QUOTE APPLYB)
(Q CANONIZE)
(Q ALGS)
(KWOTE P1)
(KWOTE P2)
(QUOTE BA1]
(COND
((NULL D)
(SWHY 6 (Can't figure out what the difference is between the definitions of (@ P1) and (@ P2)))
NIL)
([SETQ GTEMP318 (CAR (SOME (ACEX CANONIZE)
(FUNCTION (LAMBDA (C) (* The call on Lastele is because
Canonize is an active, so its final
results are the last elements of each of
its examples)
(MEMBER (ANY1OFE (GETB N (QUOTE DEFN)))
(GETB (LASTELE C)
(QUOTE DEFN] (* This Being N will be killed when we
return NIL)
(CPRIN1S 8 N turned out to be equivalent to GTEMP318 DCR) (* Note we return NIL, not GTEMP318)
NIL)
(T (INCRB GUP1 (QUOTE EXS)
(NCONC1 (GEARGS GUP1)
N))
[SOME (RIPPLE GUP1 (QUOTE GENL))
(FUNCTION (LAMBDA (G)
(SOME (GETB G (QUOTE D-R))
(FUNCTION (LAMBDA (D)
(AND (ISA P1 (CAR D))
(ISA P2 (CADR D))
(INCRB N (QUOTE UP)
(CADDR D))
(INCRB (CADDR D)
(QUOTE EXS)
N]
(* This last INCRB says that if an operation f maps onto range C, and we apply f and get a new
Being, then that Being ISA C)
(INCRB N (QUOTE IN-RAN-OF)
GUP1)
[MAPC [ATOM-INT (DSET-DIFF [APPEND (OR (GETB P1 (QUOTE GUP))
(GETB P1 (QUOTE UP)))
(OR (GETB P2 (QUOTE GUP))
(GETB P2 (QUOTE UP]
(GETB N (QUOTE UP]
(FUNCTION (LAMBDA (Z)
(COND
((APPLY* (QUOTE DEFN)
Z N)
(INCRB Z (QUOTE EXS)
N)
(INCRB N (QUOTE UP)
Z] (* We should really repeat this later
on, since many defns involve searchig
for ALGS parts, ...)
[COND
((GETB N (QUOTE UP))
(SETB N (QUOTE GUP)
(COPY (GETB N (QUOTE UP]
(* Maybe we should have something like the following, but check about the genl/spec, etc. details.
G200 should be set to a list of examples of GUP1 or Canonize
(MAPC GTEMP200 (FUNCTION (LAMBDA (E) (COND ((AND (NEQ
(CADDR E) N) (ISAG (CAR E) P1) (ISAG (CADR E) P2))
(INCRB (CADDR E) (QUOTE GENL) N) (INCRB N (QUOTE SPEC)
(CADDR E)))) (COND ((AND (NEQ (CADDR E) N) (ISAS (CAR E) P1)
(ISAS (CADR E) P2)) (INCRB (CADDR E) (QUOTE SPEC) N)
(INCRB N (QUOTE GENL) (CADDR E))))))))
(INCRB N (QUOTE D-R)
(LIST A A))
(SETB N (QUOTE WORTH)
(MAP2CAR (GETB P1 (QUOTE WORTH))
(GETB P2 (QUOTE WORTH))
(QUOTE LARGER)))
(COND
((SETQ PGM1 (COND
((ISAG A (QUOTE OBJECT))
(DEDUCE-CANON-OBJ P1 P2 N A D))
((ISAG A (QUOTE ACTIVE))
(DEDUCE-CANON-ACT P1 P2 N A D))
(T (SWHY 6 (AM gives up because (@ A)
is neither an Object nor an Active))
NIL)))
(INCRB N (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(QUOTE APPLICATION)
(QUOTE OF)
GUP1 PGM1))
N)
(T NIL])
(DEDUCE-CANON-OBJ
[LAMBDA (P1 P2 N A D PGM1) (* In addition to building up Pgm1 to
convert to canon form, we must also
build up GCAN-DEFN to test for
canonicalness)
(COND
((SETQ GTEMP304 (INDUCE-CANON-STYPE P1 A)) (* Note that this must also intialize
GCAN-DEFN)
(SETQ PGM1 (LIST (QUOTE CDR)
(QUOTE BA1)))
[MAPC D
(FUNCTION (LAMBDA (D1)
(COND
((MATCH D1 WITH (=P1 'does 'no 'recursing 'on F1←&))
(CPRIN1S 8 CRLF)
(SELECTQ F1
[(CAR FIRST)
(CPRIN1S 8 P1 doesn't look at the specific elements
in A COMMA like P2 does COMMA so AM can replace them all
by a single distinguished element COMMA say T DCR)
[SETQ GCAN-DEFN (LIST (QUOTE AND)
GCAN-DEFN
(QUOTE (EVERY (CDR BA1)
(QUOTE IS-CONSTANTT]
(SETQ PGM1 (LIST (QUOTE MAPCAR)
PGM1
(Q CONSTANTT]
(CDR (CPRIN1S 8 P1 doesn't look at any elements
of A except possibly the car
of the structure which denotes its type COMMA so AM replaces the tail
of A
by a canonical distinguished tail COMMA say NIL DCR)
[SETQ GCAN-DEFN (LIST (QUOTE AND)
GCAN-DEFN
(QUOTE (NULL (CDR BA1]
(SETQ PGM1 NIL))
(REAR (CPRIN1S 8 P1 doesn't look at any elements of A except possibly the
first element COMMA so AM replaces the tail of A
by a canonical distinguished tail COMMA say NIL DCR)
[SETQ GCAN-DEFN (LIST (QUOTE AND)
GCAN-DEFN
(QUOTE (NULL (CDDR BA1]
(SETQ PGM1 (LIST (QUOTE RPLACD)
(LIST (QUOTE APPEND)
PGM1)
NIL)))
(CPRIN1S 0 Sorry COMMA
in DEDUCE-CANON-OBJ there is a strange type of Difference that P1 doesn't recurse
on but P2 does COMMA namely COLON D1 DCR)))
(T (* None of the other transforms are in
yet; sorry)
NIL]
(SETQ PGM1 (LIST (QUOTE CONS)
GTEMP304 PGM1))
(SETQ GCAN-DEFN (LIST (QUOTE TYPE)
(QUOTE NONRECURSIVE)
(SIMPLIFY1 GCAN-DEFN)))
(SETQ PGM1 (SIMPLIFY1 PGM1)))
(T (SWHY 6 (Could not determine which kinds of structure all canonical (@ A)
APOS should follow))
NIL])
(DEDUCE-RPART
[LAMBDA (F S) (* Given a function and a structure, see
how that structure might be a
restriction of some part
(s) of f)
(* For now, just a simple enumeration of
the few possible choices)
(SETQ GRPART (CAR (SOME POSS-RPARTS (FUNCTION (LAMBDA (P)
(CONFIRM-RPART F S P])
(DEFB
[LAMBDA (B BFL)
[SETQ BFL (EQ B (CAR (UNBREAK0 B]
(PUTD B (COPY TRIVB))
[MAPC XS-PARTS (FUNCTION (LAMBDA (XP BP)
(COND
((GETB B XP)
(SETQ BP (GLUEE B XP))
(ATTACH (LIST XP (CONS BP (GETARGS XP)))
(BPFS B))
(PUTD BP (LIST (QUOTE LAMBDA)
(GETARGS XP)
(LIST (QUOTE SELF-COMPILE)
BP
(CONS (GETFNAME XP)
(FGETB B XP]
[COND
((EQ (GETB B (QUOTE INV))
T)
(* Notice that a Being can now have two clauses (INV ...), but in that case the first will
(properly) point to the ALGS e-part)
(ATTACH [LIST (QUOTE INV)
(CONS (GLUEE B (QUOTE ALGS))
(GETARGS (QUOTE ALGS]
(BPFS B]
(COND
(BFL (CPRIN1 1 CRLF CRLF "The Being " B " was broken. Defb" CRLF
" unbroke it, redefined it, and then broke it (BREAK)" DCR)
(APPLY* (QUOTE BREAK)
B))
(B])
(DEFN-AC
[LAMBDA (B Z TK)
(OR TK (SETQ TK (IPLUS (CLOCK 2)
CS-INT CS-INT 1000)))
(COND
((AND (LISTP Z)
(ISA B (QUOTE ACTIVE)))
(APPLY* (QUOTE DEFN)
B
(CAR Z)
(CADR Z)
(CADDR Z)
(CADDDR Z)
TK))
(T (APPLY* (QUOTE DEFN)
B Z NIL NIL NIL TK])
(DO-KILS
[LAMBDA NIL
(COND
((IGREATERP GCNT (CAAR KILS))
(COND
[(CADDDR (CDAR KILS))
(CPRIN1S 7 AM is forgetting one entry on the (CADDAR KILS)
facet of the (CADAR KILS)
concept DCR)
(APPLY* (QUOTE SWHY)
7
(CADDDR (CAR KILS)))
(CPRIN1S 9 TAB Because COLON (CADDDR (CAR KILS))
DCR)
(COND
[(SETB (CADAR KILS)
(CADDAR KILS)
(DREMOVE (CADDDR (CDAR KILS))
(GETB (CADAR KILS)
(CADDAR KILS]
((REMPROP (CADAR KILS)
(CADDAR KILS))
(PUTD (GLUEE (CADAR KILS)
(CADDAR KILS))
NIL]
(T (CPRIN1S 7 AM is forgetting the entire (CADDAR KILS)
facet of the (CADAR KILS)
concept DCR)
(APPLY* (QUOTE SWHY)
7
(CADDDR (CAR KILS)))
(CPRIN1S 9 TAB Because COLON (CADDDR (CAR KILS))
DCR)
(REMPROP (CADAR KILS)
(CADDAR KILS))
(PUTD (GLUEE (CADAR KILS)
(CADDAR KILS))
NIL)))
(DEFB (CADAR KILS))
(DREMOVE (CAR KILS)
KILS)
(DO-KILS])
(DOTPROD
[LAMBDA (V1 V2 DSUM)
(SETQ DSUM 0)
[MAP2C V1 V2 (FUNCTION (LAMBDA (X1 X2)
(SETQ DSUM (IPLUS DSUM (FTIMES (EVAL X1)
(EVAL X2]
DSUM])
(DOTS
[LAMBDA (N)
(COND
((ZEROP N)
SPACE)
((NOT (MINUSP N))
(PRIN1 (QUOTE %.))
(DOTS (SUB1 N])
(DRAND-PERMUTE
[LAMBDA (L L1)
(AND (SETQ L1 (RAND-MEMB L))
(CONS L1 (DRAND-PERMUTE (DREMOVE L1 L])
(DSET-DIFF
[LAMBDA (L M)
(AND [EVERY M (FUNCTION (LAMBDA (M1)
(DREMOVE M1 L]
L])
(DWIMUSERFN
[LAMBDA (X1 X3)
(AND (MATCH (UNPACK FAULTX) WITH (X1←--
'- 'E '- X3←--))
(GETHASH (SETQ X1 (PACK X1))
HCON)
(FMEMB (SETQ X3 (PACK X3))
XEQ-PARTS)
[DEFINE (LIST (LIST FAULTX (LIST (QUOTE LAMBDA)
(GETARGS X3)
(LIST (QUOTE SELF-COMPILE)
X1
(CONS (GETFNAME X3)
(GETB X1 X3]
(CONS FAULTX FAULTARGS])
(EAVG2
[LAMBDA (X Y)
(AVG2 (EVAL X)
(EVAL Y])
(ENGC
[LAMBDA (C V)
(SELECTQ (COP C)
[(FILLIN CHECK)
(CPRIN1S 0 (ENGN (COP C))
(ENGN (CP C)) of (ENGN (CB C]
[(APPLY* APPLYB)
(SELECTQ [COND
((ATOM (CP C))
(CP C))
((ISQ (CP C))
(CADR (CP C)))
(T (CPRIN1 11 "Strange... in engc ")
(CADR (CP C]
[ALGS (CPRIN1S 0 (ENGN (CB C)))
(SELECTQ (LENGTH (CARG C))
(0)
[1 (CPRIN1S 0 (ENGN (CAR (CARG C]
[2 (CPRIN1S 0 these 2 arguments COLON SPACE (ENGN (CAR (CARG C)))
and (ENGN (CADR (CARG C]
(PROGN (CPRIN1S 0 the following COLON SPACE SPACE)
(MAPC (CARG C)
(QUOTE PRINES]
(PROGN (CPRIN1S 0 APOS (CP C)
is run on these arguments COLON)
(MAPC (CARG C)
(QUOTE PRINES]
(MAPC (CACT C)
(QUOTE PRINES)))
(COND
((IGREATERP VERBOSITY V)
(ENGR C))
((TERPRI])
(ENGN
[LAMBDA (X)
(COND
((NUMBERP X)
X)
[(ATOM X)
(SELECTQ X
(FILLIN "Fill in some")
(CHECK "Check all")
(EXS "examples")
(EXS-BDY "boundary examples")
(EXS-NOT-BDY
"things which just barely miss being examples")
(EXS-NOT "non-examples")
(ALGS "algorithms to compute")
((APPLYB APPLY*)
"Execute")
(GENL "generalizations")
(SPEC "specializations")
(OR (GETP X (QUOTE ENGN))
(L-CASE X T]
((ISQ X)
(ENGN (CADR X)))
((LISTP X)
(MAPCAR X (QUOTE ENGN)))
(T X])
(ENGR
[LAMBDA (C W)
(SETQ W (CWHY C))
(SELECTQ (LENGTH W)
(0)
(1 (CPRIN1S 0 CRLF TAB The reason)
(COND
((AND (ILESSP GCNT 10)
(ILESSP ESTAT 3))
(CPRIN1S 6 for considering this Cand)))
(CPRIN1S 0 is: (CAR W)
CRLF))
(PROGN (CPRIN1S 0 CRLF TAB The (LENGTH W)
reasons)
(COND
((ILESSP GCNT VERBOSITY)
(EPRIN1S 3 for considering this Cand)))
(CPRIN1S 0 are:)
(PRINICE W)
(TERPRI])
(ENSURE
[LAMBDA (B P)
(OR (AND (OR (MEMB P FACETS)
(MEMB [PACK (DREVERSE (CDR (DREVERSE (UNPACK P]
FACETS))
(OR (GETHASH B HCON)
(CREATEB B))
(OR (GETB B P)
(INIT-PART B P)))
(CPRIN1S 1 CRLF CRLF WARNING COLON B COMMA P are not accessable COLON B COMMA P CRLF])
(ENSURE-TOP
[LAMBDA NIL
(OR (AND [COND
((ATOM CS-P)
(MEMB CS-P FACETS))
([MATCH CS-P WITH ('QUOTE &@(LAMBDA (Z)
(MEMB Z FACETS]
(SETQ CS-P (CADR CS-P]
[COND
((ATOM CS-B)
(CREATEB CS-B))
((MATCH CS-B WITH ('QUOTE &@CREATEB))
(SETQ CS-B (CADR CS-B]
(MEMB CS-OP TOP-ACTS))
(CPRIN1S 1 CRLF CRLF WARNING COLON CS OP COMMA B COMMA P aren't meaningful LPAREN yet RPAREN COLON CRLF CS-OP
COMMA CS-B COMMA CS-P])
(ENSURE1
[LAMBDA (ACT)
(AND (FMEMB (CAR ACT)
TOP-ACTS)
(IS-CON (CADR ACT))
(FMEMB (CADDR ACT)
FACETS])
(EPRIN1
[NLAMBDA CPARG
(COND
((ILESSP ESTAT (EVAL (CAR CPARG)))
(MAPC (CDR CPARG)
(FUNCTION (LAMBDA (Z)
(COND
((STRINGP Z)
(PRIN1 Z))
((FMEMB Z PUNC)
(PRIN1 (GETTOPVAL Z)))
((LISTP Z)
(PRIN1 (EVAL Z)))
((NEQ (GETTOPVAL Z)
(QUOTE NOBIND))
(PRIN1 (EVAL Z)))
((NEQ (EVALV Z)
(QUOTE NOBIND))
(PRIN1 (EVALV Z)))
(T (PRIN1 Z])
(EPRIN1S
[NLAMBDA CPARG
(COND
((ILESSP ESTAT (EVAL (CAR CPARG)))
(MAPC (CDR CPARG)
(FUNCTION (LAMBDA (Z)
(COND
((STRINGP Z)
(PRIN1 Z))
((FMEMB Z PUNC)
(PRIN1 (GETTOPVAL Z)))
((LISTP Z)
(PRIN1 SPACE)
(PRIN1 (EVAL Z)))
((NEQ (GETTOPVAL Z)
(QUOTE NOBIND))
(PRIN1 SPACE)
(PRIN1 (EVAL Z)))
((NEQ (EVALV Z)
(QUOTE NOBIND))
(PRIN1 SPACE)
(PRIN1 (EVALV Z)))
((ATOM Z)
(SETTOPVAL Z Z)
(PRIN1 SPACE)
(PRIN1 Z))
(T (PRIN1 SPACE)
(PRIN1 Z])
(EQPE
[LAMBDA (E)
(EQ (CAR E)
PE])
(ESUB2
[LAMBDA (X)
(SUB1 (SUB1 (EVAL X])
(EVERY2
[LAMBDA (X Y F)
(OR (NULL X)
(NULL Y)
(AND (APPLY* F (CAR X)
(CAR Y))
(EVERY2 (CDR X)
(CDR Y)
F])
(EXPERIMENT-MUL
[LAMBDA (P1 E NE E1 NE1 E2 NE2 ME1 NME2 ME2 NME1) (* Now get new examples to experiment
with, to see if multiple elements in
arguments to P1 hae any effect on its
value)
(COND
([NOT (PROG1 [AND [SETQ E (BIGGEST (NCONC (SUBSET (GETB P1 (QUOTE EXS-BDY))
(QUOTE MULT-STRUC-PAIR))
(SUBSET (GETB P1 (QUOTE EXS))
(QUOTE MULT-STRUC-PAIR]
[SETQ NE (BIGGEST (NCONC (SUBSET (GETB P1 (QUOTE EXS-NOT-BDY))
(QUOTE MULT-STRUC-PAIR))
(SUBSET (GETB P1 (QUOTE EXS-NOT))
(QUOTE MULT-STRUC-PAIR]
(SETQ E1 (CAR E))
(SETQ NE1 (CAR NE))
(SETQ E2 (CADR E))
(SETQ NE2 (CADR NE))
[SETQ ME1 (CONS (CAR E1)
(APPEND (CDR E1)
(CDR E1)
(RAND-SUBSET (CDR E1]
[SETQ NME2 (CONS (CAR NE2)
(APPEND (CDR NE2)
(CDR NE2)
(RAND-SUBSET (CDR NE2]
[SETQ ME2 (CONS (CAR E2)
(APPEND (CDR E2)
(CDR E2)
(RAND-SUBSET (CDR E2]
(SETQ NME1 (CONS (CAR NE1)
(APPEND (CDR NE1)
(CDR NE1)
(RAND-SUBSET (CDR NE1]
[COND
((SORTED (CDR E1))
(SETQ ME1 (SCDR ME1]
[COND
((SORTED (CDR NE1))
(SETQ NME1 (SCDR NME1]
[COND
((SORTED (CDR E2))
(SETQ ME2 (SCDR ME2]
(COND
((SORTED (CDR NE2))
(SETQ NME2 (SCDR NME2] (* Inconclusive)
(SETQ T2F T))
((AND (APPLYB P1 (QUOTE ALGS)
ME1 E2)
(APPLYB P1 (QUOTE ALGS)
E1 ME2)
(APPLYB P1 (QUOTE ALGS)
ME1 ME2)
(NOT (APPLYB P1 (QUOTE ALGS)
NE1 NME2))
(NOT (APPLYB P1 (QUOTE ALGS)
NME1 NE2))
(NOT (APPLYB P1 (QUOTE ALGS)
NME1 NME2))) (* Then the presence of multiple-eles
has no effect so we induce that P1 is
not affected by remultiple-elesing
elements of its arguments)
(CPRIN1S 8 CRLF Experiments indicate that P1 is not affected by the presence of multiple elements
in its structural arguments DCR)
(CPRIN1S 9 TAB So any canonical arguments must be Ordered-sets and Sets DCR)
(DSUBST (Q OSET)
(Q VECTOR)
(DSUBST (Q CLASS)
(Q BAG)
GCAN-DEFN))
(DSUBST (Q OSET)
(Q VECTOR)
(DSUBST (Q CLASS)
(Q BAG)
PGM2)))
(T (* The presence of multiple-eles
definitely affects the result of P1)
(CPRIN1S 8 CRLF Experiments indicate that P1 is affected by the presence of multiple elements
in its structural arguments DCR)
(CPRIN1S 9 TAB So any canonical arguments can be Bags and Lists DCR)
(DSUBST (Q VECTOR)
(Q OSET)
(DSUBST (Q BAG)
(Q CLASS)
GCAN-DEFN))
(DSUBST (Q VECTOR)
(Q OSET)
(DSUBST (Q BAG)
(Q CLASS)
PGM2])
(EXPERIMENT-ORD
[LAMBDA (P1 E NE E1 NE1 E2 NE2 NRE2 NRE1 RE1 RE2)
(COND
([NOT (AND [SETQ E (BIGGEST (NCONC (SUBSET (GETB P1 (QUOTE EXS-BDY))
(QUOTE ORD-STRUC-PAIR))
(SUBSET (GETB P1 (QUOTE EXS))
(QUOTE ORD-STRUC-PAIR]
[SETQ NE (BIGGEST (NCONC (SUBSET (GETB P1 (QUOTE EXS-NOT-BDY))
(QUOTE ORD-STRUC-PAIR))
(SUBSET (GETB P1 (QUOTE EXS-NOT))
(QUOTE ORD-STRUC-PAIR]
(SETQ E1 (CAR E))
(SETQ NE1 (CAR NE))
(SETQ E2 (CADR E))
(SETQ NE2 (CADR NE))
[SETQ NRE2 (CONS (CAR NE2)
(REVERSE (CDR NE2]
[SETQ NRE1 (CONS (CAR NE1)
(REVERSE (CDR NE1]
[SETQ RE1 (CONS (CAR E1)
(REVERSE (CDR E1]
(SETQ RE2 (CONS (CAR E2)
(REVERSE (CDR E2] (* Can't conclusively experiment with
changing order of eles)
(SETQ T1F T))
((AND (APPLYB P1 (QUOTE ALGS)
RE1 E2)
(APPLYB P1 (QUOTE ALGS)
E1 RE2)
(APPLYB P1 (QUOTE ALGS)
RE1 RE2)
(NOT (APPLYB P1 (QUOTE ALGS)
NE1 NRE2))
(NOT (APPLYB P1 (QUOTE ALGS)
NRE1 NE2))
(NOT (APPLYB P1 (QUOTE ALGS)
NRE1 NRE2))) (* Then reversing order has no effect so
we induce that P1 is not affected by
reordering elements of its arguments)
(CPRIN1S 8 CRLF Experiments indicate that P1 is not affected by reordering elements of its structural arguments
DCR)
(CPRIN1S 9 TAB So any canonical arguments can be Bags and Sets DCR)
(DSUBST (Q BAG)
(Q VECTOR)
(DSUBST (Q CLASS)
(Q OSET)
GCAN-DEFN))
(DSUBST (Q BAG)
(Q VECTOR)
(DSUBST (Q CLASS)
(Q OSET)
PGM2)))
(T (* Changing order definitely affects the
result of P1)
(CPRIN1S 8 CRLF Experiments indicate that P1 is affected by reordering elements of its arguments DCR)
(CPRIN1S 9 TAB So any canonical arguments must be Lists and Ordered-sets DCR)
(DSUBST (Q VECTOR)
(Q BAG)
(DSUBST (Q OSET)
(Q CLASS)
GCAN-DEFN))
(DSUBST (Q VECTOR)
(Q BAG)
(DSUBST (Q OSET)
(Q CLASS)
PGM2])
(FIL-ACEX
[LAMBDA (X)
(LIST (QUOTE ANY1SAT)
(LIST (QUOTE ACEX)
X])
(FIL-EX1
[LAMBDA (BA1 BA2 NB)
(LIST [LIST (LIST (QUOTE NULL)
(QUOTE BA1))
(LIST (QUOTE AND)
[LIST (QUOTE SETQ)
(QUOTE BA1)
(NCONC1 (FIL-ACEX (CAR BAL1))
(CONS (QUOTE AND)
(SUBST (QUOTE X)
(QUOTE BA1)
GTEMP9]
(LIST (QUOTE APPLYB)
(KWOTE NB)
(Q ALGS)
(QUOTE BA1)
(QUOTE BA2)
(QUOTE BA3)
(QUOTE BA4]
(LIST (QUOTE BA1)
(ATTACH (QUOTE AND)
(NCONC1 (APPEND GTEMP9)
(AQ-LIST CS-B BA1 BA2 BA3 BA4])
(FIL-EX2
[LAMBDA (BA1 BA2 NB)
(LIST (LIST (LIST (QUOTE AND)
(LIST (QUOTE NULL)
(QUOTE BA1))
(LIST (QUOTE NULL)
(QUOTE BA2)))
(LIST (QUOTE AND)
(LIST (QUOTE ANY2SAT)
(LIST (QUOTE APPEND)
(LIST (QUOTE ACEX)
(CAR BAL1)))
(LIST (QUOTE APPEND)
(LIST (QUOTE ACEX)
(CADR BAL1)))
(SETQ TMP2 (SUBSET-INVOLVING-ONLY
GTEMP9
(QUOTE BA1)))
(CONS (QUOTE AND)
(SET-DIFF GTEMP9 TMP2)))
(AQ-LIST CS-B BA1 BA2 BA3 BA4)))
(LIST (LIST (QUOTE AND)
(QUOTE BA1)
(LIST (QUOTE NULL)
(QUOTE BA2)))
(LIST (QUOTE AND)
[LIST (QUOTE SETQ)
(QUOTE GTEMP24)
(NCONC1 (FIL-ACEX (CADR BAL1))
(CONS (QUOTE AND)
(SUBST (QUOTE X)
(QUOTE BA2)
GTEMP9]
(AQ-LIST CS-B BA1 GTEMP24 BA3 BA4)))
(LIST (LIST (QUOTE AND)
(LIST (QUOTE NULL)
(QUOTE BA1))
(QUOTE BA2))
(LIST (QUOTE AND)
[LIST (QUOTE SETQ)
(QUOTE GTEMP23)
(NCONC1 (FIL-ACEX (CAR BAL1))
(CONS (QUOTE AND)
(SUBST (QUOTE X)
(QUOTE BA1)
GTEMP9]
(AQ-LIST CS-B GTEMP23 BA2 BA3 BA4)))
(LIST (LIST (QUOTE AND)
(QUOTE BA1)
(QUOTE BA2))
(CONS (QUOTE AND)
(APPEND GTEMP9
(LIST (AQ-LIST CS-B BA1 BA2 BA3 BA4])
(FIL-EX3
[LAMBDA (BA1 BA2 NB)
(LIST (LIST (LIST (QUOTE AND)
[LIST (QUOTE ANY3SAT)
(LIST (QUOTE OR)
(QUOTE BA1)
(LIST (QUOTE ACEX)
(CAR BAL1)))
(LIST (QUOTE OR)
(QUOTE BA2)
(LIST (QUOTE ACEX)
(CADR BAL1)))
(LIST (QUOTE OR)
(QUOTE BA3)
(LIST (QUOTE ACEX)
(CADDR BAL1)))
(SETQ TMP2 (SUBSET-INVOLVING-ONLY
GTEMP9
(QUOTE BA1)))
[SETQ TMP3 (SUBSET-INVOLVING-ONLY
(SET-DIFF GTEMP9 TMP2)
(LIST (QUOTE BA1)
(QUOTE BA2]
(CONS (QUOTE AND)
(SET-DIFF GTEMP9 (APPEND
(CDR TMP2)
(CDR TMP3]
(AQ-LIST CS-B BA1 BA2 BA3 BA4])
(FIL-STRUC-P
[LAMBDA (P CG CGL TK1)
(SETQ CG (RIPPLE CS-B (QUOTE GENL)))
[SETQ CGL (LENGTH (SETQ GTEMP315 (DREMOVE CS-B (KINDS-OF (QUOTE STRUCTURE]
(SETQ TK1 (RMUL (CAR (GETB CS-B (QUOTE WORTH)))
200 CGL))
(MAPCONC GTEMP315 (FUNCTION (LAMBDA (S TKNT)
(SETQ TKNT (IPLUS TK1 (CLOCK 2)))
(MAPCONC (GETB S P)
(FUNCTION (LAMBDA (X1)
(AND (ILESSP (CLOCK 2)
TKNT)
(SUBSET (DREMOVE NIL (APPLY* (QUOTE VIEW)
CS-B X1 S NIL T CG))
(FUNCTION (LAMBDA (V)
(APPLY* (QUOTE DEFN)
CS-B V])
(FIND-NEW-CANDS
[LAMBDA NIL
(CPRIN1S 6 CRLF Must find new candidates and merge them into (QUOTE CANDS)
DCR)
(SETQ INTHRESH (IN-FACTOR DO-THRESH))
(ADD-CANDS (MAPCONC CONCEPTS (QUOTE UNFORGETTABLE])
(FIRSTN
[LAMBDA (N L)
(COND
((MINUSP N)
NIL)
((LDIFF L (FNTH L (ADD1 N])
(FLATTEN
[LAMBDA (L)
(COND
((NLISTP L)
(LIST L))
((MAPCONC L (QUOTE FLATTEN])
(FORMAT
[NLAMBDA Z
(CONS (QUOTE FORMAT)
Z])
(FOU
[LAMBDA (C)
(CAADAR (FNTH G-IF (CADR C])
(FOU1
[LAMBDA (C)
(CAR (FNTH G-IF (CADR C])
(FOU2
[LAMBDA (C)
(CADAR (CDDAR (FNTH G-IF (CADR C])
(FRIPPLE-G
[LAMBDA (RB)
(CONS RB (MAPCONC (GETB RB (QUOTE GENL))
(QUOTE FRIPPLE-G])
(FRIPPLE-S
[LAMBDA (RB) (* Play with the idea of compiling this
(via Macro) as (RIPPLE B
(QUOTE SPEC)), or perhaps define it that
way)
(CONS RB (MAPCONC (GETB RB (QUOTE SPEC))
(QUOTE FRIPPLE-S])
(FSET-NTH
[LAMBDA (S N X)
(CAR (FRPLACA (FNTH S N)
X])
(GARGS
[LAMBDA (B)
(APPEND (FIRSTN [SUB1 (LENGTH (CAR (GETB B (QUOTE D-R]
BA-LIST])
(GATH
[LAMBDA (B GENB GENP)
(* the old version was: COND ((SETQ GENB (CAR (APPLYB B
(QUOTE UP) (QUOTE FILLIN)))) (COND ((GETHASH (SETQ GENP
(GLUE GENB GATH-PART)) HCON) (ATTACH GENP GPGM))) (COND
((GETHASH (SETQ GENP (GLUE GENB (QUOTE ANYP))) HCON)
(ATTACH GENP GPGM))) (GATH GENB)))
(RIPPLE B GATH-PART (QUOTE GENL])
(GEARGS
[LAMBDA (B)
(MAPCAR (GARGS B)
(QUOTE EVAL])
(GENL1RDEF
[LAMBDA (DE REC S ILV EILV TILV TDEF TNAM)
[SETQ GTEMP51 (NEWNAME (SETQ TNAM (GLUE (QUOTE GENL)
CS-B]
(SETQ GTEMP308 (CINL (GFNAMES S)))
(CPRIN1S 5 TAB AM generalizes CS-B into the new concept GTEMP51 COMMA by not recursing
on the GTEMP308 of each arg DCR)
(CPRIN1S 8 i.e. COMMA GTEMP51 will not have a recursive check CRLF like this one COMMA which is present
in CS-B COLON CRLF)
(COND
((IGREATERP VERBOSITY 8)
(PRINICE S)
(TERPRI)))
[SETQ TDEF (DSUBST (LIST (QUOTE PROG1)
T
(SPLIST COMMENT in CS-B this is S))
(QUOTE ZCOM)
(DSUBST GTEMP51 CS-B (SUBST (QUOTE ZCOM)
S DE]
(COND
([AND (NEQ GTEMP51 TNAM)
(SETQ GTEMP60 (CAR (SOME (GETB CS-B (QUOTE GENL))
(FUNCTION (LAMBDA (G)
(MEMBER TDEF (GETB G (QUOTE DEFN]
(SWHY 7 (The proposed new generalization turned out to be identical to (@ GTEMP60)))
(CPRIN1S 7 TAB Failed DCR))
(T (CREATEB GTEMP51)
(INCRB GTEMP51 (QUOTE DEFN)
TDEF)
[INCRB GTEMP51 (QUOTE TIES)
(LIST CS-B (LIST (QUOTE DEFN)
(SPLIST GTEMP51 does no recursing on GTEMP308]
(* Note the format assumed for TIES part
entry is (other-B-name
(part1name (relnship1) ...
(relnship-n)) (part2name...)))
[COND
[(ISA CS-B (QUOTE ACTIVE))
[INCRB GTEMP51 (QUOTE D-R)
(APPEND (CAR (GETB CS-B (QUOTE D-R]
(COND
((ISA CS-B (QUOTE PREDICATE)) (* IN general, we want to see if Genl
(CS-b) are also Genl
(Gtemp51); eg., so that ISA will work
right)
[INCRB GTEMP51 (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE TRANSFORM)
(QUOTE REDUCING-TO)
(QUOTE SELF)
(LIST (QUOTE APPLYB)
(KWOTE GTEMP51)
(Q DEFN)
(QUOTE BA1)
(QUOTE BA2)
(QUOTE BA3)
(QUOTE BA4]
(INCRB (QUOTE PREDICATE)
(QUOTE EXS)
GTEMP51)
(INCRB GTEMP51 (QUOTE UP)
(QUOTE PREDICATE)))
(T (INCRB (QUOTE ACTIVE)
(QUOTE EXS)
GTEMP51)
(INCRB GTEMP51 (QUOTE UP)
(QUOTE ACTIVE]
(T (INCRB GTEMP51 (QUOTE UP)
(QUOTE ANYB))
(ADD-CANDS (LIST (LIST (LIST (QUOTE FILLIN)
GTEMP51
(QUOTE UP))
(ADD1 (OR EILV (AVG2 ILV CS-INT)))
(LIST (SPLIST While working
on the generalization GTEMP51
of CS-B COMMA AM could not trivially determine what the (QUOTE UP)
part should be]
(INCRB GTEMP51 (QUOTE SPEC)
CS-B)
(INCRB CS-B (QUOTE GENL)
GTEMP51)
(SETB GTEMP51 (QUOTE WORTH)
(RPLACINT (APPEND (GETB CS-B (QUOTE WORTH)))
(AVG2 ILV 600) (* We probably want to indicate that
Gtemp51 has very tenuous grounds for
existence, and it should be justified
quickly or killed)
))
[ADD-CANDS (LIST (LIST (LIST (QUOTE FILLIN)
GTEMP51
(QUOTE EXS))
(OR EILV (AVG2 ILV CS-INT))
(LIST (SPLIST The generalization GTEMP51
of CS-B is relatively new and has no exs
of its own yet COMMA excepting those of CS-B]
(* Sometime we should check that the new
Bs are not just equal to some
already-existing one, either trivially
(syntactically) or by func equiv)
GTEMP51])
(GENLIZE-RECDEF
[LAMBDA (D DBOD BASE REC ILV SPL)
(SETQ DBOD (CAR (FLAST D)))
(COND
[[OR (MATCH DBOD WITH ('OR BASE←$
REC←&))
(MATCH DBOD WITH ('COND BASE←$
(REC←&)))
(MATCH DBOD WITH ('COND BASE←$
('T $ REC←&]
(CPRIN1 6 CRLF " Considering genlizing a recursive defn of "
CS-B CRLF)
[SETQ ILV (FIX (DOTPROD (GETB CS-B (QUOTE WORTH))
(LIST .7 .2]
(COND
((ILESSP ILV DO-THRESH)
(CPRIN1 7 TAB "Stopped")
(CPRIN1 8 TAB " because not interesting enuf")
(SWHY 7 (The estimated interest level for (@ CS-B)
right now is only
(@ ILV)
,which is way
below my
threshhold
for doing anything:(@ DO-THRESH)))
(CPRIN1 7 DCR))
((SELECTQ
(CAR REC)
(AND
(CPRIN1 8 TAB "Will try to remove a conjunct")
(CPRIN1 17 " from: ")
(CPRIN1 17 (PRINICE REC))
(CPRIN1 8 DCR)
[SETQ SPL (SUBSET (CDR REC)
(FUNCTION (LAMBDA (Z)
(MATCH Z
WITH ('APPLYB ('QUOTE =CS-B)
('QUOTE 'DEFN)
$]
(SELECTQ
(LENGTH SPL)
(0 (CPRIN1 8 TAB
"Failed. No member of Rec is a simple call on "
CS-B " itself" DCR TAB
"Later, I may check whether this defn is really recursive or not" DCR)
)
(1 (CPRIN1 8
"Failed. Only one simple recursive call on itself. No easy genlz" DCR)
)
(PROGN (CPRIN1 9 TAB (LENGTH SPL)
" possible conjuncts to choose from"
DCR)
[SETQ GTEMP51
(MAPCAR SPL (FUNCTION (LAMBDA (S)
(GENL1RDEF D REC S ILV
(IDIFFERENCE
CS-INT
(LENGTH SPL]
(CPRIN1S 8 CRLF If any of GTEMP51 ever seems
to be too specialized COMMA AM will
consider conjoining it
with other members of that set DCR)
[MAPC GTEMP51
(FUNCTION (LAMBDA (Z)
(SUGGEST Z (QUOTE SPEC)
(LIST (QUOTE APPLYB)
(Q CONJOIN)
(Q ALGS)
(KWOTE (REMOVE Z
GTEMP51))
(SPLIST An
intermediate
level
of specialization
COMMA between
CS-B
and Z COMMA
would be
to Conjoin Z
with some
of
these COLON
(REMOVE
Z GTEMP51]
GTEMP51)))
(OR (CPRIN1 8 TAB "Will try to add a new disjunct")
(CPRIN1 17 " from: " REC)
(CPRIN1 8 DCR) (* This isnt in yet)
(CPRIN1 8 "ISNT IN YET. FAIL." CRLF))
(CPRIN1 9 TAB
"Can't go on: can only handle AND and OR recs."
CRLF "Rec is: " REC CRLF]
((CPRIN1 10 " I wanted to genlize the recursive defn of " CS-B
COMMA CRLF D COMMA CRLF TAB
"but this doesn't match any pattern I know" DCR])
(GET-NAMES
[LAMBDA NIL
(SETQ LASTNAME (COND
((EQ USERNAME (QUOTE LENAT))
(CPRIN1S 0 CRLF Please type in your last name LPAREN
then carriage-return RPAREN COLON)
(U-CASE (RATOM)))
(T USERNAME)))
(SETQ FIRSTNAME (COND
((NEQ (QUOTE NOBIND)
(GETTOPVAL LASTNAME))
(GETTOPVAL LASTNAME))
((EQ (QUOTE Doug)
FIRSTNAME)
(QUOTE TYRO))
(T (SET FIRSTNAME 0)
FIRSTNAME)))
(SETQ ESTAT (COND
((MINUSP (GETTOPVAL FIRSTNAME))
0)
(T (SUB1 (SETTOPVAL FIRSTNAME (ADD1 (GETTOPVAL FIRSTNAME])
(GET-SEEN
[LAMBDA NIL
(SETQ V1REASON 4)
(SETQ V-REASON 8)
(* These can be reset; the first value is the minimum verbosity level to see the reason for the
chosen candidate; the second is the min verbosity level to see the reasons for all SEENCANDS
candsidates each time)
(SETQ SEENCANDS
(COND
((SELECTQ UCONTROL
((0 1 2)
(CPRIN1S 0 CRLF Do you want me to tell you which new Cand I'm about to work on each time QUES)
(DISMISS (SELECTQ ESTAT
(0 6000)
((1 2)
4000)
1500))
(COND
((READP)
(FMEMB (RATOM)
YES-LIST))
((ILESSP VERBOSITY 2)
(PRIN1 "no")
NIL)
(T (PRIN1 "yes")
T)))
(PROGN (CPRIN1S 0 CRLF Before deciding which new Cand to work on, I'll print my top choices DCR)
T))
(CPRIN1S 0 CRLF How many Candidates would you like to see each time QUES SPACE)
[SETQ S1 (IPLUS (RMUL UCONTROL 1 2)
(SMALLER 3 (IQUOTIENT VERBOSITY 4]
(CPRIN1S 2 CRLF TAB LPAREN "I suggest " S1 RPAREN COLON SPACE)
(CLEARBUF T T)
(DISMISS (SELECTQ ESTAT
(0 9000)
((1 2)
6000)
4000))
(COND
((READP)
(RNUM))
(T (CPRIN1S 0 SPACE SPACE S1 DCR)
S1)))
(T 0)))
[AND (IGREATERP UCONTROL 2)
(IGREATERP VERBOSITY 4)
(SELECTQ SEENCANDS
(0 NIL)
[1 (CPRIN1S 2 CRLF Should (QUOTE I)
tell you my reasons for the Cand (QUOTE I)
select each time QUES SPACE)
(COND
((EQ (QUOTE Y)
(ASKUSER 4 (COND
((ILESSP VERBOSITY 4)
(QUOTE N))
(T (QUOTE Y)))
SPACE NIL T NIL))
(SETQ V1REASON (SUB1 VERBOSITY))
(SETQ V-REASON (ITIMES 2 V1REASON)))
(T (SETQ V1REASON (ADD1 VERBOSITY))
(SETQ V-REASON (ITIMES 2 V1REASON]
(PROGN (CPRIN1S 2 CRLF Should (QUOTE I)
tell you my reasons for each Cand (QUOTE I)
am considering selecting each time QUES SPACE)
(COND
((EQ (QUOTE Y)
(ASKUSER 4 (COND
((ILESSP VERBOSITY 9)
(QUOTE N))
(T (QUOTE Y)))
SPACE NIL T NIL))
(SETQ V-REASON (SUB1 VERBOSITY))
(SETQ V1REASON (IQUOTIENT V-REASON 2)))
(T (SETQ V-REASON (ADD1 VERBOSITY))
(CPRIN1S 2 CRLF Should (QUOTE I)
tell you my reasons for the Cand (QUOTE I)
actually select each time QUES SPACE)
(COND
((EQ (QUOTE Y)
(ASKUSER 4 (COND
((ILESSP VERBOSITY 4)
(QUOTE N))
(T (QUOTE Y)))
SPACE NIL T NIL))
(SETQ V1REASON (SUB1 VERBOSITY)))
(T (SETQ V1REASON (ADD1 VERBOSITY]
SEENCANDS])
(GET-UCON
[LAMBDA NIL
(CPRIN1S 0 User-control Level LPAREN 0 - 10 COMMA or SPACE QUES RPAREN SPACE DOT DOT DOT DOT)
(SETQ UCONTROL (RATOM))
(COND
((AND (FIXP UCONTROL)
(ILESSP UCONTROL 100)))
((EQ UCONTROL (QUOTE ?))
(SETQ UCONTROL 0)
(CPRIN1S 0 CRLF TAB User-control = the degree
to which you supervise AM APOS activities CRLF TAB In this system COMMA User-control is just a
numeric-valued variable CRLF TAB TAB which the top-level control functions look at DCR TAB User-control
level 0 lets you gain control only via ↑I DCR TAB User-control level 5 lets you see a few
of AM APOS alternatives COMMA CRLF TAB TAB and waits 6 seconds
for you
to OK its choice DCR TAB User-control level 10 displays several alternative Candidates COMMA CRLF TAB TAB
and waits indefinitely
until you to select one DCR CRLF)
(GET-UCON))
(T (SETQ UCONTROL 1)
(CPRIN1S 0 CRLF No COMMA no EXCLAIM Please type in a positive integer COMMA in the CRLF interval 0
to 10 COMMA inclusive COMMA followed by a carriage-return COMMA CRLF or type in a question-mark COMMA
followed
by carriage-return DCR CRLF)
(GET-UCON)))
UCONTROL])
(GET-VERBO
[LAMBDA NIL
(CPRIN1 0 "Verbosity Level (1 - 10, or ?) .... ")
(EPRIN1S 2 LPAREN Please terminate your response with a carriage-return RPAREN SPACE DOT DOT DOT)
(SETQ VERBOSITY (RATOM))
(COND
((AND (FIXP VERBOSITY)
(ILESSP VERBOSITY 100)))
((EQ VERBOSITY (QUOTE ?))
(SETQ VERBOSITY 1)
(CPRIN1S 0 CRLF TAB Verbosity = the amount of data that AM spews out
to FIRSTNAME DCR TAB In this system COMMA Verbosity is just a numeric-valued variable CRLF TAB TAB which the
Printing functions look at DCR TAB Verbosity level 0 suppresses all messages DCR TAB Verbosity level 5
lets most important messages get printed DCR TAB Verbosity level 10 dumps out enough
to actually get some CRLF TAB TAB feeling for the inner workings of AM DCR CRLF)
(EPRIN1S 1 TAB The suggested value for FIRSTNAME is 8 DCR CRLF)
(GET-VERBO))
(T (SETQ VERBOSITY 1)
(CPRIN1S 0 CRLF No COMMA no EXCLAIM Please type in a positive integer COMMA in the CRLF interval 1
to 10 COMMA inclusive COMMA followed by a carriage-return COMMA CRLF or type in a question-mark COMMA
followed
by carriage-return DCR CRLF)
(GET-VERBO)))
VERBOSITY])
(GET-WAIT
[LAMBDA NIL
[SETQ AM-WAIT (ITIMES 1000 (SETQ AM-WSECS (LARGER (RMUL SEENCANDS 4 3)
UCONTROL]
(CPRIN1S (SUB1 ESTAT)
CRLF TAB If you have not typed anything within AM-WSECS seconds after a prompt COMMA
then AM will fill in a default answer for you DCR)
(EPRIN1S 2 A space will suffice to keep AM from defaulting on you COMMA CRLF while you think about what
to reply to any question AM asks you DCR)
(EPRIN1S 1 In general COMMA your response should be terminated by a carriage return DCR)
[COND
((IGREATERP UCONTROL 2)
(CPRIN1S 0 CRLF Would you like to reset this waiting time QUES SPACE)
(CLEARBUF T T)
(DISMISS (IPLUS AM-WAIT 3000))
(COND
((OR [AND (READP)
(FMEMB (RATOM)
(LIST (QUOTE Y)
(QUOTE YES)
(QUOTE y)
(QUOTE yes]
(COND
((IGREATERP UCONTROL 5)
(CPRIN1S 0 yes CRLF)
T)
(T (CPRIN1S 0 no CRLF)
NIL)))
(CPRIN1S 0 Number of seconds I should wait before defaulting on you COLON SPACE)
(SETQ AM-WAIT (ITIMES 1000 (SETQ AM-WSECS (RNUM]
AM-WSECS])
(GETARGS
[LAMBDA (P)
(GETP P (QUOTE ARGS])
(GETB-OR
[LAMBDA (B P1 P2)
(OR (GETB B P1)
(GETB B P2])
(GETB-P
[LAMBDA (B)
(GETB B P])
(GETB-P-C
[LAMBDA (B)
(COPY (GETB B P])
(GETBQ
[NLAMBDA (B P)
(GETB B P])
(GETFNAME
[LAMBDA (P)
(GETP P (QUOTE FNAM])
(GETU
[LAMBDA (B PROP)
(GET (GETTOPVAL B)
PROP])
(GETUP
[LAMBDA (B)
(APPEND (GETB B (QUOTE UP])
(GETUPN
[LAMBDA (B)
(APPEND (GETB B (QUOTE UP-NOT])
(GETX
[LAMBDA (B)
(APPEND (GETB B (QUOTE EXS])
(GETXB
[LAMBDA (B)
(APPEND (GETB B (QUOTE EXS-BDY])
(GETXNB
[LAMBDA (B)
(APPEND (GETB B (QUOTE EXS-NOT-BDY])
(GEXADD
[LAMBDA (X)
(SETQ GEXISTING (UNION GEXISTING X))
X])
(GFNAME
[LAMBDA (L)
(COND
((NLISTP L)
L)
((EQ (CAR L)
(QUOTE APPLYB))
(GFNAME (CADR L)))
((ISQ L)
(GFNAME (CADR L)))
(T (GFNAME (CAR L])
(GFNAMES
[LAMBDA (L)
(SELF-INT (MAPCAR (CDDDR L)
(QUOTE GFNAME])
(GLUE
[LAMBDA (B P) (* A more sophisticated scheme can be
implemented: e.g., using HASHing)
(PACK (LIST B (QUOTE -)
P])
(GLUE-CANO
[LAMBDA (A B)
(GLUE-IF-ABLE A B (QUOTE CANONIZE-)
(QUOTE CAN-])
(GLUE-IF-ABLE
[LAMBDA (B1 B2 NBIG NLIT NB)
(COND
((ILESSP (IPLUS 5 (NCHARS B1)
(NCHARS B2))
MAXNAME)
(PACK (LIST NBIG B1 (QUOTE &)
B2)))
(T (CPRIN1S 0 CRLF Name of new Being is too long COLON CRLF NLIT B1 & B2 CRLF)
(CLEARBUF T T)
(SETQ NB (NEWNAME (ABBREV1 (CONCAT NLIT B1 (QUOTE &)
B2)
MAXNAME)))
(COND
((AND (IGREATERP VERBOSITY 3)
(IGREATERP UCONTROL 3)
(IGREATERP SEENCANDS 1))
(CPRIN1S 3 If you want COMMA give me a short new name
for it SPACE LPAREN my suggestion is NB SPACE RPAREN COLON SPACE)
(CLEARBUF T T)
(DISMISS AM-WAIT)
(COND
((READP)
(RATOM))
(T NB)))
(T NB])
(GLUEC
[LAMBDA (A B)
(GLUE-IF-ABLE A B (QUOTE COMPOSE-)
(QUOTE COM-])
(GLUEE
[LAMBDA (B P) (* A more sophisticated scheme can be
implemented: e.g., using HASHing)
(PACK (LIST B (QUOTE -E-)
P])
(GRAND-STRUC
[LAMBDA NIL (* If we are in the midst of a tight
loop, then keep the structure the same;
else change it)
(APPEND (COND
((IN-A-LOOP)
GSTRUC)
(T (SETQ GSTRUC (RAND-MEMB (ACEX STRUCTURE])
(GS-CHECK
[LAMBDA (B)
(* See if B is related to some B' both by Genl and
Spec; then conclude that B=B')
(AND (GETB B (QUOTE GENL))
(GETB B (QUOTE SPEC))
(MAKE-IDENTICAL (INTERSECTION
[SETB B (QUOTE GENL)
(DREMOVE B (GETB B (QUOTE GENL]
(SETB B (QUOTE SPEC)
(DREMOVE B (GETB B (QUOTE SPEC])
(GTRANSFER
[LAMBDA (GEX NEWGP)
(DECRB CS-B CS-P GEX)
(COND
((OR (FMEMB (SETQ GTEMP4 NEWGP)
FACETS)
(FMEMB (SETQ GTEMP4 (GLUE CS-P NEWGP))
FACETS))
(BOOST1 (SUB1 (AVG2 CS-INT INTHRESH))
(QUOTE CHECK)
CS-B GTEMP4 NIL (SPLIST Some (ENGN GTEMP4)
were recently added to CS-B COMMA entries that AM previously thought were
(ENGN CS-P)))
(INCRB CS-B GTEMP4 GEX))
(T (CPRIN1S 1 CRLF WARNING COLON SPACE GTEMP4 is not a real part name DCR TAB (QUOTE GTRANSFER)
was called with (QUOTE GEX)
= GEX COMMA and (QUOTE NEWGP)
= NEWGP DCR)
NIL])
(HANDLE-CANON
[LAMBDA (BA1 BA2 BA3)
[COND
((NOT (AND (ISA BA1 (QUOTE PREDICATE))
(ISA BA2 (QUOTE PREDICATE))
(NEQ BA1 BA2)))
(SETQ GTEMP12 NIL))
((IS-CON (SETQ GTEMP12 (GLUE-CANO BA1 BA2))) (* Note that we are assuming that there
will not be more than 1 canonization for
any given pair of predicates)
[SETQ GUP1 (COND
((ISAG CS-B (QUOTE CANONIZE))
CS-B)
(T (QUOTE CANONIZE]
(INCRB GUP1 (QUOTE EXS)
(NCONC1 (GEARGS GUP1)
GTEMP12))
(INCRB GTEMP12 (QUOTE IN-RAN-OF)
GUP1)
GTEMP12)
([SETQ GTEMP11 (SOME [SETQ GTEMP200 (NCONC (MAPCAR (EXS-BDY CANONIZE)
(QUOTE LASTELE))
(MAPCAR (EXS CANONIZE)
(QUOTE LASTELE]
(FUNCTION (LAMBDA (Z)
(SOME (GETB Z (QUOTE DEFN))
(FUNCTION (LAMBDA (D)
(MATCH D WITH ('TYPE 'APPLICATION 'OF & ('APPLYB ('QUOTE 'CANONIZE)
('QUOTE 'ALGS)
('QUOTE =BA1)
('QUOTE =BA2)
$]
(SETQ GTEMP12 (CAR GTEMP11)))
((SETQ GTEMP11 (DEDUCE-CANON BA1 BA2 GTEMP12 [SETQ GTEMPA (CAR (ANY1OFE (GETB BA1 (QUOTE D-R]
(CONTRAST-DEFNS BA1 BA2)))
(GS-CHECK GTEMP12)
(CPRIN1 (COND
((MATCH CS-ACT WITH ('APPLYB ('QUOTE 'CANONIZE)
$))
7)
(T 98))
CRLF Succeeded EXCLAIM CRLF)
(* Here we must boost or do the following: (1) Create a new specialization of GTEMPA =
(Car (any1ofe (getb BA1 D-R))) called Canonical-A, which contains just those A's which are
Gtemp12-canonical, with all the GTEMPA defns suitably transformed;
and (2) create new specializations of BA1 and BA2, called Canon-restric-BA1 and -BA2, which have the
same defns as BA1 and BA2 but are restricted to the domain Canonical-A x Canonical-A;
(3) with much less interest level, consider all things in the IN-DOM-OF part of A, and consider
restricting those operations to Canonical-A; (4) with even less intensity, consider how those ops in
IN-RAN-OF (GTEMPA) might be restricted so as to only map into Canonical-A;
some of these are true for ANY new specialization of a Being GTEMPA)
(SETBQ CANONIZE GWORTH (APPEND (GETBQ CANONIZE WORTH)))
(RPLACA (GETB (QUOTE CANONIZE)
(QUOTE WORTH))
(RMUL (CAR (GETB (QUOTE CANONIZE)
(QUOTE WORTH)))
3 2))
(BLOWUP-CANR GTEMPA GTEMP12 BA1 BA2) (* This binds Newb to the name of the
new canonical class of GTEMPA)
(BOOST1 (IDIFFERENCE CS-INT 2)
(QUOTE APPLYB)
(Q RESTRICT)
(Q ALGS)
(LIST (KWOTE BA1)
(KWOTE NEWB)
(Q DOMAIN))
(SPLIST BA1 was one
of the predicates which defined the new concept NEWB COMMA so it is worth considering the
restriction
of BA1
to that subset of GTEMPA APOS))
(CPRIN1S 6 CRLF Some conjectures that AM considers believable COLON CRLF CRLF BA2 COMMA restricted
to canonical GTEMPA APOS COMMA is indistinguishable
from BA1 DCR CRLF There is a powerful analogy between CRLF)
(COND
((IGREATERP VERBOSITY 6)
(TERPRI)
(PAD BA1 33 BA2)
(PAD GTEMPA 33 NEWB)
(PAD "operators on and into" 33 "those operators restricted to")
(PADI GTEMPA 33 NEWB)
(PAD "statements involving these" 33 "statements involving these")
(TERPRI)))
[INCRB BA1 (QUOTE ANAS)
(LIST BA2 (LIST BA1 BA2)
(LIST GTEMPA NEWB)
(LIST (QUOTE ANY-OPERATION)
(LIST (QUOTE APPLYB)
(Q RESTRICT)
(Q ALGS)
(Q ANY-OPERATION)
(KWOTE NEWB]
[MAPC (OR (GETB GTEMPA (QUOTE IN-DOM-OF))
(APPLY* (QUOTE IN-DOM-OF)
GTEMPA))
(FUNCTION (LAMBDA (ID)
(BOOST1 (SMALLER (DOTPROD (NCONC (LIST CS-INT DO-THRESH INTHRESH)
(GETB ID (QUOTE WORTH)))
(LIST .5 .1 .1 .1 .1 .1))
(IDIFFERENCE CS-INT 5))
(QUOTE APPLYB)
(Q RESTRICT)
(Q ALGS)
(LIST (KWOTE ID)
(KWOTE NEWB)
(Q DOMAIN))
(SPLIST ID operates on the space GTEMPA COMMA for which we now have a canonical
representation]
[MAPC (GETB GTEMPA (QUOTE IN-RAN-OF))
(FUNCTION (LAMBDA (ID)
(BOOST1 (SMALLER (DOTPROD (NCONC (LIST CS-INT DO-THRESH INTHRESH)
(GETB ID (QUOTE WORTH)))
(LIST .3 .1 .1 .1 .1 .1))
(IDIFFERENCE CS-INT 8))
(QUOTE APPLYB)
(Q RESTRICT)
(Q ALGS)
(LIST (KWOTE ID)
(KWOTE NEWB)
(Q RANGE))
(SPLIST ID maps into the space GTEMPA COMMA for which we now have a canonical representation]
(* Note that those ops whose dom and ran
are both GtempA will be highly
reinforced)
NEWB)
(T (KILB GTEMP12)
(CPRIN1 (COND
((MATCH CS-ACT WITH ('APPLYB ('QUOTE 'CANONIZE)
$))
6)
(T 97))
CRLF Failed DCR) (* Note we are tampering with the SUGG
and the WORTH part of this very Being)
(RPLACA (GETB (QUOTE CANONIZE)
(QUOTE WORTH))
(RMUL (CAR (GETB (QUOTE CANONIZE)
(QUOTE WORTH)))
2 3]
(COND
((AND BA3 (IS-CON GTEMP12))
(APPLYB GTEMP12 (QUOTE ALGS)
BA3))
((IS-CON GTEMP12])
(HANDLE-I
[LAMBDA (B D A)
(CPRIN1S 0 CRLF Interestingness of DOT DOT DOT QUES)
(SETQ B (READ))
(CPRIN1S 0 SPACE R/L QUES)
(EPRIN1S 3 LPAREN (QUOTE R)
means Raise COMMA (QUOTE L)
means Lower RPAREN SPACE)
(SETQ D (RATOM)) (* B is the Being or Cand, D is the
direction of the change, A is the Amount
it is changed)
(CPRIN1S 0 CRLF How much QUES)
(EPRIN1S 3 LPAREN 0 means slightly COMMA 10 means tremendously RPAREN SPACE)
(SETQ A (RNUM))
(HANDLE-I1 B D A])
(HANDLE-I-INTERRUPT
[LAMBDA (ITMP)
(CPRIN1 -1 CRLF CRLF (QUOTE ?)
COLON SPACE)
(DISMISS 2000)
(COND
((NOT (READP))
(CPRIN1 1 LPAREN (QUOTE W)
COMMA
(QUOTE I)
COMMA
(QUOTE E)
COMMA
(QUOTE M)
COMMA
(QUOTE N)
COMMA
(QUOTE ?)
COMMA Q RPAREN SPACE)))
(SELECTQ (RATOM)
((I i)
(HANDLE-I))
((Q q)
(CPRIN1S 0 Quitting DOT Resuming execution))
((N n)
(HANDLE-N))
((E e)
(CPRIN1S 0 Eval of DOT DOT DOT)
(PRIN1 (SETQ ITMP (READ)))
(CPRIN1S 0 is (EVAL ITMP)))
((W w)
(CPRIN1S -1 TAB Why COLON GWHY)
(SETQ GWHY DUNNO))
(? (CPRIN1S -1 CRLF Here are more detailed explanations of your options COLON CRLF (QUOTE W)
TAB Why COLON AM gives FIRSTNAME the
explanation behind its last printed CRLF TAB
TAB message DCR (QUOTE I)
TAB Interest COLON FIRSTNAME can modify the
interest ratings
of concepts and CRLF TAB TAB Candidates DCR
(QUOTE E)
TAB Evaluate COLON FIRSTNAME
types
in an expression and AM runs EVAL on it DCR (QUOTE M)
TAB Message COLON What was the last message that AM did
(QUOTE NOT)
type out CRLF TAB TAB because the verbosity was too low QUES
CRLF (QUOTE N)
TAB Name COLON Rename some concept
to whatever you want to call it DCR (QUOTE Q)
TAB Quit COLON resume execution DCR CRLF In general COMMA AM will
automatically resume execution after answering one query DOT You must hit ↑I
again
to interrupt DCR)
(HANDLE-I-INTERRUPT))
((M m)
(CPRIN1S -1 TAB Last LPAREN unseen RPAREN message COLON GMSG)
(SETQ GWHY MWHY)
(SETQ MWHY DUNNO))
(PROGN (CPRIN1S -1 CRLF No COMMA no EXCLAIM Type only the initial
of the command you want COLON CRLF TAB)
(EPRIN1S 5 Why COMMA Interest COMMA Evaluate COMMA Message COMMA Quit COMMA or
else type a question-mark DCR)
(HANDLE-I-INTERRUPT)))
(PRIN1 CRLF)
(CLOCK 2])
(HANDLE-I1
[LAMBDA (B D A)
(COND
[(IS-CON B)
(RPLACA (CAR (GETB B (QUOTE WORTH)))
(IPLUS (CAR (GETB B (QUOTE WORTH)))
(RMUL [IDIFFERENCE (SELECTQ D
(R 1000)
0)
(CAR (GETB B (QUOTE WORTH]
A 10]
[(AND (LISTP B)
(ENSURE1 B)) (* Assumed to be a Cand)
(ADD1CAND B (RMUL (SELECTQ D
(R 800)
-800)
A 10)
(PROGN (CPRIN1S 0 CRLF If you know why COMMA tell me COLON SPACE)
(DISMISS 5000)
(OR (AND (READP)
(CONS (RATOM)
(READLINE)))
(PRINT (SPLIST Direct suggestion by FIRSTNAME]
(T (CPRIN1S 0 Can't understand this DCR You must type
in either the name of a specific Being COMMA CRLF TAB or
else a specific candidate COMMA
in the format CRLF TAB LPAREN (QUOTE A)
(QUOTE B)
(QUOTE P)
RPAREN COMMA CRLF TAB
where CRLF TAB TAB (QUOTE A) = Action to be taken COMMA like FILLIN or CHECK CRLF TAB TAB
(QUOTE (QUOTE B)) = The name
of a specific concept
to work on crlf tab tab (QUOTE (QUOTE P)) = The specific facet of (QUOTE (QUOTE B))
to apply (QUOTE (QUOTE A)) to DCR CRLF)
(HANDLE-I])
(HANDLE-N
[LAMBDA (N1 N2)
(CPRIN1S 0 CRLF Rename which existing concept QUES)
(SETQ N1 (RCON))
(CPRIN1S 0 CRLF What is its new name QUES)
(SETQ N2 (RATOM))
(RENAME2BS N2 N1)
(CPRIN1S 0 CRLF Done DCR CRLF])
(I-USED
[LAMBDA (N)
(CADDDR (CAR (FNTH G-IF N])
(I-USED2
[LAMBDA (N)
(CADDDR (CAR (FNTH (IFEATURES (GETB B (QUOTE INT)))
N])
(I-USED3
[LAMBDA (N)
(CAR (FNTH (IFEATURES (GETB B (QUOTE INT)))
N])
(IMATRIX
[LAMBDA NIL 0])
(IN-A-LOOP
[LAMBDA (SRES) (* A Predicate to see if we are
currently inside a tight loop)
[SEARCHPDL (FUNCTION (LAMBDA (N V)
(COND
((FMEMB N LOOP-FNS)
(SETQ SRES T)
T)
((IS-CON N)
(SETQ SRES NIL)
(NEQ N (QUOTE CONSTANT-STRUC)))
(T NIL]
SRES])
(IN-FACTOR
[LAMBDA (N)
(COND
(CVAL (IQUOTIENT N 2))
(T (IQUOTIENT N 3])
(INCR
[NLAMBDA (Z)
(SET Z (ADD1 (EVAL Z])
(INCR-TIE
[LAMBDA (B1 B2 P V BOTH IT1 IT2)
(COND
[[SETQ IT1 (FASSOC B2 (GETB B1 (QUOTE TIES]
(COND
[(SETQ IT2 (FASSOC P (CDR IT1)))
(COND
((MEMBER V (CDR IT2)))
(T (NCONC1 IT2 V]
(T (NCONC IT1 (LIST P V]
(T (INCRB B1 (QUOTE TIES)
(LIST B2 (LIST P V])
(INCR-USED
[LAMBDA (N B X CV)
(* N is the number of the interestingness factor used, located on the INT part of Being B;
X is the name of the new Being who uses this factor)
[COND
((ATOM N)
(SETQ N (LIST N]
(SETQ N (SUBSET N (QUOTE NUMBERP)))
(AND N B X (MAPC N (FUNCTION (LAMBDA (N1)
(COND
((SETQ CV (I-USED2 N1 B))
(NCONC1 CV X))
(T (NCONC1 (I-USED3 N1 B)
(LIST (QUOTE USED)
X])
(INCRB
[LAMBDA (B P X) (* Note that for speed, we do NOT have
this fn return any definite value that
can be relied on)
(COND
((MEMBER X (GETB B P)))
(X (SETB B P (NCONC1 (GETB B P)
X])
(INDUCE-CANON-STYPE
[LAMBDA (P1 A PGM2 T1F T2F)
(COND
((CAN-BE-1-STYPE P1) (* Altho the experimenting fns don't use
it, maybe they should get and use A, and
only draw examples from AxA)
(SETQ PGM2 (LIST (QUOTE SELECTQ)
(LIST (QUOTE CAR)
(QUOTE BA1))
(LIST (QUOTE BAG)
(Q BAG))
(LIST (QUOTE CLASS)
(Q CLASS))
(LIST (QUOTE VECTOR)
(Q VECTOR))
(Q OSET)))
[SETQ GCAN-DEFN (LIST (QUOTE AND)
(LIST (QUOTE APPLY*)
(Q DEFN)
(KWOTE A)
(QUOTE BA1)
NIL NIL NIL (QUOTE TK2))
(LIST (QUOTE FMEMB)
(LIST (QUOTE CAR)
(QUOTE BA1))
(LIST (QUOTE LIST)
(Q BAG)
(Q CLASS)
(Q VECTOR)
(Q OSET] (* See if reordering affects the value
of P1)
(EXPERIMENT-ORD P1) (* Now get new examples to experiment
with, to see if multiple elements in
arguments to P1 hae any effect on its
value)
(EXPERIMENT-MUL P1) (* T1F and T2F are flags which indicate
whether any conclusion was reached about
ordering and multiple eles,
respectively)
[OR T1F T2F (SETQ GTEMPA (STRUCTYPE (LIST (PROG (BA1)
(RETURN (EVAL PGM2] (* That OR just reset the x part of
"canonical-x" if a unique type was
found)
PGM2)
(T (SETQ GCAN-DEFN (LIST (QUOTE APPLY*)
(Q DEFN)
(KWOTE A)
(QUOTE BA1)
NIL NIL NIL (QUOTE TK2)))
(SETQ PGM2 (LIST (QUOTE CAR)
(QUOTE BA1])
(INIT-VARS
[LAMBDA NIL
(SETQ PKNT 0)
(SETQ GCNT 1)
(SETQ MERGE-PARTS (CDR FACETS)) (* This just discounts the WORTH facet,
which is numerical)
[MAPC CONCEPTS (FUNCTION (LAMBDA (X)
(REMPROP X (QUOTE FEX]
(SETQ ACEXPIRE 4)
(SETQ GWHY DUNNO)
(SETQ GINT-CONS (LIST -1))
(SETQ CS-ACT NIL)
(SETQ CVAL NIL)
(SETQ MWHY DUNNO)
[MAPC BA-LIST (FUNCTION (LAMBDA (BA)
(SET BA NIL]
(SETQ DO-THRESH INIT-DOTHRESH)
(SETQ CS-INT 200)
(SETQ EX-THRESH INIT-EXTHRESH)
(SETQ DEFN-STAK (LIST (QUOTE STAK-BOTM)))
(SETQ INT-THRESH INIT-INT-THRESH)
(SETQ INTHRESH INIT-INTHRESH)
(SETQ KILS (COPY INIT-KILS))
(SETQ PAST (COPY INIT-PAST))
(SETQ CANDS (COPY INIT-CANDS])
(INS1CAND
[LAMBDA (C I1 C2)
(COND
((ILESSP I1 INTHRESH)
NIL)
([SETQ C2 (SOME CANDS (FUNCTION (LAMBDA (C1)
(NOT (ILESSP I1 (CINT C1]
(ATTACH C C2))
(T (NCONC1 CANDS C)))
C])
(INSTAN-1D
[LAMBDA (D BASE REC PAT P SFN DTYP DBOD CR CC CARGS CB CBX TEXS SUCC-TEXS)
(MATCH D WITH (SFN←&
DTYP←$
DBOD←&))
(SELECTQ (CAR DTYP)
[RECURSIVE (AND [OR (MATCH DBOD WITH ('OR BASE←$
REC←&))
(MATCH DBOD WITH ('COND BASE←$
(REC←&)))
(MATCH DBOD WITH ('COND BASE←$
('T REC←$]
(NCONC (INSTAN-BASE BASE)
(INSTAN-REC REC]
[NONRECURSIVE (OR (AND (EQUAL (CAR DBOD)
(QUOTE AND))
(SIMULT-SATISFY (CDR DBOD)))
(AND (MATCH DBOD WITH ('MATCH 'BA1 'WITH PAT←&))
(INSTAN-PAT PAT))
(AND (MATCH DBOD WITH (&@[LAMBDA (Z)
(OR (EQ Z (QUOTE EQ))
(EQ Z (QUOTE EQUAL]
CR←&
CC←&))
(CR-INVERT CR CC]
[TRANSFORM (OR (AND (MATCH DBOD WITH ('AND CC←$
('APPLYB ('QUOTE CB←&@IS-CON)
('QUOTE 'DEFN)
CARGS←$)))
(COND
((ISA CS-B (QUOTE ACTIVE))
(INSTAN-ACT-TRANS CB CC CARGS))
((MATCH CC WITH (('SOME CBX←&
REC←&)))
[SETQ SUCC-TEXS (SUBSET (SETQ TEXS (APPLY* (QUOTE EXS)
CB))
(FUNCTION (LAMBDA (BA1)
(EVAL (CAR CC]
(APPENDB CS-B (QUOTE EXS-NOT-BDY)
(SET-DIFFERENCE TEXS SUCC-TEXS))
SUCC-TEXS)))
(AND (MATCH DBOD WITH ('APPLYB ('QUOTE CB←&@IP
CON)
('QUOTE 'ALGS)
CARGS←$))
(INSTAN-TRANSF DBOD]
(QUASIRECURSIVE NIL)
(APPLICATION (* I THINK THIS IS JUST EVAL OF THE
FINAL MEMBER OF TYPE,...)
NIL)
(PC (* PRED. CALC. MUST TRANSFORM
(BAJ X) INTO (APPLYB BAJ ALGS
(TRANSFORM X)))
NIL)
(BRANCH NIL)
(IMPLICIT NIL)
(CPRIN1 0 CRLF "******* WARNING: NOT A KNOWN TYPE OF DEFN: " D CRLF " EVAL OF CADR OF THIS IS: " P CRLF
"BACK-TRACING: " CRLF (AM-BT)
CRLF])
(INSTAN-1I
[LAMBDA (I)
(GEXADD (ERRORSET I])
(INSTAN-1S
[LAMBDA (S)
NIL])
(INSTAN-ACT-TRANS
[LAMBDA (CB CC CARGS TMPD LOSE TMP-BLIST)
(* This is where all the thinking goes. Where do i get the right stuff to put in...
do i go from the reduced-to BEING, and check to see if it meets the new requirements, etc.)
[SETQ TMP-BLIST (MAP2CAR BA-LIST (ANY1OFE (GETB CS-B (QUOTE D-R)))
(FUNCTION (LAMBDA (BA BB)
(COND
((FMEMB (EVAL BA)
(APPLY* (QUOTE ACEX)
BB)) (* Then this BAi must already have been
instantiated and bound)
NIL)
(T (LIST BA (APPLY* (QUOTE ACEX)
BB]
(AND (EVERY TMP-BLIST (QUOTE CADR))
[OR ETIM (SETQ ETIM (MINUS (IPLUS (CLOCK 2)
10000
(ITIMES CS-INT 60]
(PROG NIL
L5 [MAPC TMP-BLIST (FUNCTION (LAMBDA (BA)
(SET (CAR BA)
(RAND-MEMB (CADR BA]
(COND
([AND (EVERY CC (QUOTE EVAL))
(SETQ TMPD (APPLY (QUOTE REBB)
(CONS (QUOTE (SOMEE (GETB CB (QUOTE DEFN))
(QUOTE INSTAN-1D)))
(MAPCAR CARGS (QUOTE EVAL]
(CPRIN1 9 " In instantiating the definition of " CS-B ",
which actually is just that of " CB ", plus " (LENGTH CC)
" new
constraints, AM has in fact found an example.")
(CPRIN1 10 " in " (QUOTIENT (IPLUS (CLOCK 2)
ETIM 10000 (ITIMES CS-INT 60))
1000.0)
" seconds." CRLF " The example is: " TMPD)
(CPRIN1 9 CRLF)
(RETURN TMPD))
((MINUSP (IPLUS (CLOCK 2)
ETIM))
(GO L5))
(T (CPRIN1 9 " Sorry, AM ran out of time, trying to find an example of" CRLF CS-B
", which by the way reduces to " CB ", plus " (LENGTH CC)
" new conditions." CRLF)
[MAPC TMP-BLIST (FUNCTION (LAMBDA (Z)
(SET (CAR Z)
NIL]
(RETURN NIL])
(INSTAN-BASE
[LAMBDA (BASE BEX)
(SOMEE BASE (FUNCTION (LAMBDA (BASE1)
(AND (LISTP BASE1)
(NULL (CDR BASE1))
(SETQ BASE1 (CAR BASE1)))
(AND (MATCH BASE1 WITH (&@[LAMBDA (Z)
(OR (EQ Z (QUOTE EQ))
(EQ Z (QUOTE EQUAL]
'BA1 BEX←&))
(ERRORSET BEX])
(INSTAN-D
[LAMBDA (DE)
(MAPCONC DE (FUNCTION (LAMBDA (D1)
(MAPC BA-LIST (QUOTE SELF))
(SETQ ETIM NIL)
(CPRIN1S 95 Instantiating (CADR D1)
defn DCR)
(INSTAN-1D D1])
(INSTAN-I
[LAMBDA (IN)
(MAPCONC IN (QUOTE INSTAN-1I])
(INSTAN-PAT
[LAMBDA (PAT1)
(SETQ PAT1 (COPY PAT1))
(ATTACH (QUOTE LIST)
PAT1)
(DSUBST (LIST (QUOTE RAND-THING))
(QUOTE &)
PAT1)
(SETQ PAT1 (LSUBST (LIST (LIST (QUOTE RAND-THING))
(LIST (QUOTE RAND-THING)))
(QUOTE --)
PAT1))
(SETQ PAT1 (LSUBST (LIST (LIST (QUOTE RAND-THING))
(LIST (QUOTE RAND-THING)))
(QUOTE $)
PAT1)) (* This should be made recursive, on
CAR, it should call itself if LISTP,
else check unpack for ←)
(GEXADD (ERRORSET PAT1])
(INSTAN-REC
[LAMBDA (REC1 DPROC BOP)
(SETQ REC1 (COPY REC1))
(AND (EQ (CAR REC1)
(QUOTE APPLYB))
(EQ (EVAL (CADDR REC1))
(QUOTE DEFN))
(OR (EQ (EVAL (CADR REC1))
CS-B)
(CPRIN1 2 CRLF "Warning from INSTAN-REC: The concept " (CADR REC1)
", which = "
(EVAL (CADR REC1))
" is NOT equal to CS-B, which = " CS-B CRLF)
T)
(SETQ DPROC (CADDDR REC1))
(GEXADD (OR [AND (EQ (CAR DPROC)
(QUOTE APPLYB))
(EQ (EVAL (CADDR DPROC))
(QUOTE ALGS))
(SETQ BOP (EVAL (CADR DPROC)))
(GETHASH BOP HCON)
(LIST (APPLYB BOP (COND
((APPLYB (QUOTE CONSTRUCTIVE-OP)
(QUOTE DEFN)
BOP)
(QUOTE ALGS))
(T (QUOTE INV)))
(CADDDR DPROC)
(CAR (CDDDDR DPROC))
(CADR (CDDDDR DPROC]
(ERRORSET DPROC])
(INSTAN-S
[LAMBDA (SP)
(MAPCONC SP (QUOTE INSTAN-1S])
(INSTAN-TRANSF
[LAMBDA (DBOD CARGS CB TMPD LOSE TMP-BLIST)
[SETQ TMP-BLIST (MAP2CAR BA-LIST (ANY1OFE (GETB CS-B (QUOTE D-R)))
(FUNCTION (LAMBDA (BA BB)
(COND
((FMEMB (EVAL BA)
(APPLY* (QUOTE ACEX)
BB)) (* Then this BAi must already have been
instantiated and bound)
NIL)
(T (LIST BA (APPLY* (QUOTE ACEX)
BB]
(AND (EVERY TMP-BLIST (QUOTE CADR))
[OR ETIM (SETQ ETIM (MINUS (IPLUS (CLOCK 2)
10000
(ITIMES CS-INT 60]
(PROG NIL
L5 [MAPC TMP-BLIST (FUNCTION (LAMBDA (BA)
(SET (CAR BA)
(RAND-MEMB (CADR BA]
(COND
([AND (EVERY2 (MAPCAR CARGS (QUOTE EVAL))
[ALL-BUT-LAST (ANY1OFE (GETB CB (QUOTE D-R]
(QUOTE ISA))
(SETQ TMPD (APPLY (QUOTE REBB)
(CONS DBOD (MAPCAR CARGS (QUOTE EVAL]
(CPRIN1S 9 In instantiating the definition
of CS-B COMMA which twists into that of CB COMMA AM has found an example)
(CPRIN1 10 " in " (QUOTIENT (IPLUS (CLOCK 2)
ETIM 10000 (ITIMES CS-INT 60))
1000.0)
" seconds." CRLF " The example is: " TMPD)
(CPRIN1 9 DCR)
(RETURN TMPD))
((MINUSP (IPLUS (CLOCK 2)
ETIM))
(GO L5))
(T (CPRIN1 9 " Sorry, AM ran out of time, trying to find an example of" CRLF CS-B
", which by the way reduces to " CB DCR)
[MAPC TMP-BLIST (FUNCTION (LAMBDA (Z)
(SET (CAR Z)
NIL]
(RETURN NIL])
(INT-CONS
[LAMBDA NIL (* Gather up some interesting concepts
-- relevant to CS-B, perhaps)
(SET-DIFF (COND
[(IGREATERP GCNT (CAR GINT-CONS))
(CDR (SETQ GINT-CONS (CONS (IPLUS 3 GCNT)
(FIRSTN 5 (SORT (APPEND CONCEPTS)
(FUNCTION (LAMBDA (C1 C2)
(ILESSP (CAR (GETB C2 (QUOTE WORTH)))
(CAR (GETB C1 (QUOTE WORTH]
(T (CDR GINT-CONS)))
(STACK-BS])
(INT-ENUF
[LAMBDA (S P IM CM)
(SETQ GREM NIL)
(SETQ GUSED NIL)
(SETQ GENG (LIST (QUOTE COMMENT)))
(SETQ GIFN (SELECTQ P
(DEFN (QUOTE IDEF))
(QUOTE IVAL)))
(SETQ NEW-ILEV 200)
(COND
((SETQ G-IF (IFEATURES S))
(SETQ IM (IMAT S))
[MAPC IM (FUNCTION (LAMBDA (CYC TV1)
(COND
((EVERY CYC (QUOTE NOT-USED-YET))
(SETQ TV1 (MAXI CYC (QUOTE SORV)))
[COND
((IGREATERP (CAR TV1)
INT-THRESH)
(SETQ NEW-ILEV (PLUS NEW-ILEV (CAR TV1)))
(NCONC1 GENG (APPEND (FOU2 TV1)))
(SETQ GUSED (NCONC1 GUSED (CADR TV1)))
(SETQ CM (NCONC1 CM (FOU TV1]
(* (NUMBERP (CADR TV1)) (SETQ GREM (NCONC1 GREM (FOU1 TV1))) I think that all references to GREM can
be commented away, since the remaining int features are automatically deduced from the USED subparts
as we frippleg)
NIL]
[SETQ NEW-ILEV (IQUOTIENT NEW-ILEV (ADD1 (LENGTH CM]
CM])
(INT-PREDS
[LAMBDA NIL (* This can be made fancier later --
E.G., cut off those with wrong no.
of args, or with lo enuf int)
GINTPREDS])
(INV-EX
[LAMBDA (E)
(COND
((EQUAL (LASTELE E)
BA1)
(CONS (QUOTE VECTOR)
(ALL-BUT-LAST E])
(INV-STYP
[LAMBDA (S)
(SELECTQ S
(SET-STRUC (QUOTE SET))
(LIST-STRUC (QUOTE LIST))
(BAG-STRUC (QUOTE BAG))
(OSET-STRUC (QUOTE OSET))
(COND
((ISAG S (QUOTE SET-STRUC))
(QUOTE SET))
((ISAG S (QUOTE LIST-STRUC))
(QUOTE LIST))
((ISAG S (QUOTE BAG-STRUC))
(QUOTE BAG))
((ISAG S (QUOTE OSET-STRUC))
(QUOTE OSET))
(T (QUOTE STRUC])
(INVQ
[LAMBDA (L)
(COND
((LISTP L)
(EVAL L))
(L])
(IS-CON
[LAMBDA (B)
(GETHASH B HCON])
(IS-CON-L
[LAMBDA (B)
(AND (GETHASH B HCON)
(LIST B])
(IS-CONN
[LAMBDA (N N1)
(SETQ N1 (IS-CON N))
(COND
((EQ N1 N)
N)
(N1 (IS-CONN N1])
(IS-CONSTANTT
[LAMBDA (Z)
(EQ Z (CONSTANTT Z])
(IS-ONE-OF
[LAMBDA (X XSET)
(AND X XSET (CAR (OR (FMEMB X XSET)
(SOME (RIPPLE X (QUOTE GENL))
(FUNCTION (LAMBDA (Z)
(FMEMB Z XSET])
(ISA
[LAMBDA (BNAME BTYPE TK2)
(COND
((NOT (IS-CON BTYPE)) (* Call on Defn in this case)
NIL)
[(NOT (IS-CON BNAME)) (* Call on Defn in this case)
(* This might lead to an infinite loop:)
(APPLY* (QUOTE DEFN)
BTYPE BNAME NIL NIL NIL (OR TK2 (IPLUS CS-INT (CLOCK 2)
1000]
((FMEMB BTYPE (GETB BNAME (QUOTE UP)))
T)
((FMEMB BTYPE (GETB BNAME (QUOTE UP-NOT)))
NIL)
([OR [SOME (GETB BNAME (QUOTE UP))
(FUNCTION (LAMBDA (U)
(ISAG U BTYPE]
(SOME (GETB BNAME (QUOTE GENL))
(FUNCTION (LAMBDA (G)
(ISA1 G BTYPE]
(* Actually, a 3rd way that this could be proven -- or disproven -- is the fact that
(BN ISA BT) iff (APPLYB BT (QUOTE DEFN) BN) is non-null.
This might turn out to be faster when the system is big;
perhaps use a cost measure on the time to run the Defn part of BT)
(INCRB BNAME (QUOTE UP)
BTYPE)
T)
(T (INCRB BNAME (QUOTE UP-NOT)
BTYPE)
NIL])
(ISA1
[LAMBDA (BNAME BTYPE)
(COND
((FMEMB BTYPE (GETB BNAME (QUOTE UP)))
T)
((FMEMB BTYPE (GETB BNAME (QUOTE UP-NOT)))
NIL)
([OR [SOME (GETB BNAME (QUOTE UP))
(FUNCTION (LAMBDA (U)
(ISAG U BTYPE]
(SOME (GETB BNAME (QUOTE GENL))
(FUNCTION (LAMBDA (G)
(ISA1 G BTYPE] (* Notice: no permanent record of
success is kept here)
T)
(T (* Notice: no permanent record of
failure is kept here)
NIL])
(ISAG
[LAMBDA (BN BT)
(OR (EQ BN BT)
(FMEMB BT (GETB BN (QUOTE GENL)))
(FMEMB BT (RIPPLE BN (QUOTE GENL])
(ISAS
[LAMBDA (BN BT)
(OR (EQ BN BT)
(FMEMB BT (GETB BN (QUOTE SPEC)))
(FMEMB BT (RIPPLE BN (QUOTE SPEC])
(ISQ
[LAMBDA (L)
(EQ (QUOTE QUOTE)
(CAR L])
(IVOP-CHK1
[LAMBDA NIL
(COND
((ISAG [LASTELE (ANY1OFE (GETB CS-B (QUOTE D-R]
(QUOTE STRUC-OF-STRUCS))
(PROG (ES ES1)
(SETQ ES (GETB CS-B CS-P))
L2 (COND
((SETQ GTEMP372 (SASSOC (CAAR ES)
(CDR ES)))
(SETQ ES1 (LASTELE (CAR ES)))
(DREMOVE GTEMP372 ES)
(INCR GCEKNT)
[MAPC (CDR (LASTELE GTEMP372))
(FUNCTION (LAMBDA (E)
(SETQ ES1 (APPLYB (QUOTE STRUCTURE-INSERT)
(QUOTE ALGS)
E ES1]
(DSUBST ES1 (LASTELE (CAR ES))
(CAR ES))
(GO L2))
((SETQ ES (CDR ES))
(GO L2))
(T (RETURN NIL])
(IVOP-FIL1
[LAMBDA NIL
(COND
([SOME (GETB CS-B (QUOTE DEFN))
(FUNCTION (LAMBDA (D)
(MATCH D WITH ('TYPE 'TRANSFORM 'REDUCING-TO & ('EVERY & ('FUNCTION ('LAMBDA
$
('AND $ ('APPLYB ('QUOTE
GTEMP371←&)
('QUOTE 'DEFN)
$ 'BA1]
[SETQ GTEMP370 (MAPCAR (GETB GTEMP371 (QUOTE EXS))
(FUNCTION (LAMBDA (E) (* Actually, CLASS and VECTOR should be
X1 and X2, where the domain is the
X1-OF-X2s type of STRUC-OF-STRUCS
concept)
(LIST (LASTELE E)
(LIST (QUOTE CLASS)
(CONS (QUOTE VECTOR)
(ALL-BUT-LAST E]
(BOOST1 (AVG2 CS-INT (LENGTH GTEMP370))
(QUOTE CHECK)
CS-B
(QUOTE EXS)
NIL
(SPLIST Some very superficial COMMA unreliable stategies were employed
in getting examples of the inverted operation named CS-B))
GTEMP370])
(KILB
[LAMBDA (B)
[MAPC (GETB B (QUOTE GENL))
(FUNCTION (LAMBDA (S)
(DECRB S (QUOTE SPEC)
B]
[MAPC (GETB B (QUOTE EXS))
(FUNCTION (LAMBDA (S)
(DECRB S (QUOTE UP)
B]
[MAPC (GETB B (QUOTE UP))
(FUNCTION (LAMBDA (S)
(DECRB S (QUOTE EXS)
B]
[MAPC (GETB B (QUOTE SPEC))
(FUNCTION (LAMBDA (S)
(DECRB S (QUOTE GENL)
B]
(PUTD B NIL)
(PUTHASH B NIL HCON)
(DREMOVE B GINTPREDS) (* Be sure to remove
this if a smarter
"interesting predicate list" scheme is devised)
(DREMOVE B CONCEPTS)
(* Really, we should follow up links like GENL from
B, and destroy all mention of it anywhere)
(RPLACD B NIL])
(KINDS-OF
[LAMBDA (K)
(OR (APPLY* (QUOTE SPEC)
K)
(PROGN
(* Perhaps we are willing to work hard here, to the extent of:
(SUBSET CONCEPTS (FUNCTION (LAMBDA (KC) (FMEMB K (APPLYB KC
(QUOTE GENL)))))))
NIL])
(LAPP
[LAMBDA (A B)
(APPEND (COND
((LISTP A)
A)
(T (LIST A)))
(COND
((LISTP B)
B)
(T (LIST B])
(LARGER
[LAMBDA (A B)
(COND
((ILESSP A B)
B)
(A])
(LASTELE
[LAMBDA (L)
(COND
((NLISTP L)
L)
((CAR (FLAST L])
(LINN
[LAMBDA (X) (* List, If Not Null)
(COND
(X (LIST X])
(LLOCATE
[LAMBDA (X L NFLG) (* Each time we recurse into or out of a
NOT, the value of the logical variable
GLOC-NOT flips)
(COND
((NLISTP L)
NIL)
((AND (EQ (CAR L)
X)
(NOT (AND NFLG GLOC-NOT)))
L)
[(OR (EQ (CAR L)
(QUOTE NOT))
(EQ (CAR L)
(QUOTE NULL)))
(SETQ GLOC-NOT (NOT GLOC-NOT))
(OR (LLOCATE X (CADR L))
(SETQ GLOC-NOT (NOT GLOC-NOT]
(T (SOMEE (CDR L)
(QUOTE LLOCX])
(LLOCX
[LAMBDA (L)
(LLOCATE X L NFLG])
(LONGEST
[LAMBDA (L)
(PROG (M)
L1 [COND
((NULL L)
(RETURN M))
((IGREATERP (LENGTH (CAR L))
(LENGTH M))
(SETQ M (CAR L]
(SETQ L (CDR L))
(GO L1])
(M2
[LAMBDA (J C1)
(SETQ CAND (CAR CANDS))
[SELECTQ SEENCANDS
(0)
(1 (CPRIN1S 0 CRLF CRLF The top Cand is:)
(ENGC CAND V1REASON))
(PROGN (CPRIN1S 0 CRLF CRLF The top SEENCANDS Cands are: CRLF)
(FOR J FROM 1 TO SEENCANDS AS C1 IN CANDS DO (PROGN (CPRIN1S 0 SPACE SPACE SPACE J COLON)
(ENGC C1 V-REASON)))
[SELECTQ UCONTROL
(0)
(1)
[(2 3 4 5 6 7 8)
(CPRIN1S 0 CRLF I choose first Cand DOT TAB OK QUES SPACE)
(PROG (CW)
L1 (CLEARBUF T T)
L2 (DISMISS AM-WAIT)
(COND
[(READP)
(SETQ CW (READ))
(COND
[(NUMBERP CW)
(SETQ CAND (CAR (FNTH CANDS CW]
((FMEMB CW YES-LIST))
((FMEMB CW NO-LIST)
(CPRIN1S 0 Please type
in the number of the Cand you suggest COMMA or
else type SPACE QUES)
(CLEARBUF T T)
(DISMISS AM-WAIT)
(GO L2))
((EQ CW (QUOTE ?))
(CPRIN1S 0 There are (LENGTH CANDS)
total Candidates on (QUOTE CANDS)
DCR)
(CPRIN1S 0 In more detail COMMA the top Cands are: CRLF)
(FOR J FROM 1 TO (IPLUS 3 SEENCANDS) AS C1 IN CANDS
DO (PROGN (CPRIN1S 0 SPACE SPACE SPACE J COLON value = (CINT C1)
SEMICOLON SPACE SPACE)
(ENGC C1 -1)))
(CPRIN1S 0 CRLF Please type y COMMA n COMMA a number COMMA
or just wait AM-WSECS seconds DCR)
(GO L1))
(T (CPRIN1S 0 No COMMA no EXCLAIM Please type y COMMA n COMMA a number COMMA
a question-mark COMMA or just wait AM-WSECS seconds DCR)
(GO L1]
(T (CPRIN1S 0 yes DCR]
(PROGN (CPRIN1S 0 CRLF Which Cand should I do next QUES SPACE)
(SETQ CAND (CAR (FNTH CANDS (RNUM]
(COND
((AND (IGREATERP VERBOSITY (SUB1 V1REASON))
(ILESSP VERBOSITY (ADD1 V-REASON)))
(ENGR CAND]
CAND])
(MAKE-IDENTICAL
[LAMBDA (BS)
(SELECTQ (LENGTH BS)
(0 NIL)
(1 T)
(2 (* Must make the 2 Beings identical.)
(MERGE2BS (CAR BS)
(CADR BS)))
(NOT-IN-YET])
(MAP-JOINABLE
[LAMBDA (S OP1)
(SETQ MAIN-D-R NIL)
(SETQ SYNTH-RANGE NIL)
(AND [NULL (CDDAR (GETB OP1 (QUOTE D-R]
[OR [AND (ISAG S (QUOTE STRUC-OF-STRUCS))
(SETQ MAIN-D-R (CAR (SOME (GETB OP1 (QUOTE D-R))
(FUNCTION (LAMBDA (Z) (* Actually, it must only be ISA of the
proper kind of struc)
(AND (ISA (LASTELE Z)
(QUOTE ANY-STRUC))
(RIGHT-STRUC Z]
(SETQ MAIN-D-R (CAR (SOME (GETB OP1 (QUOTE D-R))
(FUNCTION (LAMBDA (Z)
(AND (EQ (CAR Z)
(QUOTE ANYTHING))
(ISA (LASTELE Z)
(QUOTE ANY-STRUC]
(SETQ SYNTH-RANGE (CAR (SOFS-DECODE S])
(MAP-REPLACE2ABLE
[LAMBDA (S S2 OP1)
(SETQ MAIN-D-R NIL)
(SETQ SYNTH-RANGE NIL)
(AND [OR [AND (ISAG S (QUOTE STRUC-OF-STRUCS))
(SETQ MAIN-D-R (CAR (SOME (GETB OP1 (QUOTE D-R))
(QUOTE RIGHT-STRUC]
(SETQ MAIN-D-R (FASSOC (QUOTE ANYTHING)
(GETB OP1 (QUOTE D-R]
(NULL (CDDDR MAIN-D-R))
(ISAG S2 (CADDR MAIN-D-R))
(OR [SOME (APPLY* (QUOTE GENL)
S)
(FUNCTION (LAMBDA (SS1)
(SOME (APPLY* (QUOTE GENL)
(LASTELE MAIN-D-R))
(FUNCTION (LAMBDA (SS2)
(SETQ SYNTH-RANGE (SOFS SS1 SS2]
(SETQ SYNTH-RANGE S))
SYNTH-RANGE])
(MAP-REPLACEABLE
[LAMBDA (S OP1)
(SETQ MAIN-D-R NIL)
(SETQ SYNTH-RANGE NIL)
(AND [OR [AND (ISAG S (QUOTE STRUC-OF-STRUCS))
(SETQ MAIN-D-R (CAR (SOME (GETB OP1 (QUOTE D-R))
(QUOTE RIGHT-STRUC]
(SETQ MAIN-D-R (FASSOC (QUOTE ANYTHING)
(GETB OP1 (QUOTE D-R]
(NULL (CDDR MAIN-D-R))
(OR [SOME (APPLY* (QUOTE GENL)
S)
(FUNCTION (LAMBDA (S1)
(SOME (APPLY* (QUOTE GENL)
(LASTELE MAIN-D-R))
(FUNCTION (LAMBDA (S2)
(SETQ SYNTH-RANGE (SOFS S1 S2]
(SETQ SYNTH-RANGE S])
(MAPAPPEND
[LAMBDA (XSET F)
(APPLY (QUOTE APPEND)
(MAPCAR XSET F])
(MAX2
[LAMBDA (X1 X2 F MVAL MCAN)
(SETQ MVAL -1)
[MAP2C X1 X2 (FUNCTION (LAMBDA (Z1 Z2 TMV)
(AND (SETQ TMV (APPLY* F Z1 Z2))
(ILESSP MVAL TMV)
(SETQ MVAL TMV)
(SETQ MCAN (LIST Z1 Z2 TMV]
(CONS MVAL MCAN])
(MAXI
[LAMBDA (MSET MFN)
(PROG (TV MC (MVAL -1000))
L1 [COND
((NULL MSET)
(RETURN (LIST MVAL MC)))
((IGREATERP (SETQ TV (APPLY* MFN (CAR MSET)))
MVAL)
(SETQ MVAL TV)
(SETQ MC (CAR MSET]
(SETQ MSET (CDR MSET))
(GO L1])
(MERGE2BS
[LAMBDA (A B B1 A1) (* A absorbs B's parts)
(SETQ A1 (ENGN A))
(SETQ B1 (GETHASH B HCON))
[MAPC CONCEPTS (FUNCTION (LAMBDA (C)
(COND
((EQ B1 (GETHASH C HCON))
(PUTHASH C A HCON)
(PUT C (QUOTE ENGN)
A1]
[MAPC MERGE-PARTS (FUNCTION (LAMBDA (P)
(NCONCB A P (GETB B P] (* We shouldn't just NCONCB, but, eg,
choose the faster leading defn from the
2 concepts, to keep as the leading defn
here)
(INCRB A (QUOTE IDEN)
(LIST A B))
[SETB A (QUOTE WORTH)
(FOR I FROM 1 TO 12 COLLECT (SAD3 (CAR (FNTH (GETB A (QUOTE WORTH))
I))
(CAR (FNTH (GETB B (QUOTE WORTH))
I]
[MAPC LNK-PARTS (FUNCTION (LAMBDA (P)
(SETB A P (SUBSET (GETB A P)
(FUNCTION (LAMBDA (E)
(NEQ (IS-CONN E)
(IS-CONN A]
(RPLACD B (CDR A))
(DEFB A)
(PUTD B (GETD A))
(SETQ B A])
(MIN2
[LAMBDA (X1 X2 F MVAL MCAN)
(SETQ MVAL 1000)
[MAP2C X1 X2 (FUNCTION (LAMBDA (Z1 Z2 TMV)
(AND (SETQ TMV (APPLY* F Z1 Z2))
(ILESSP TMV MVAL)
(SETQ MVAL TMV)
(SETQ MCAN (LIST Z1 Z2 TMV]
MCAN])
(MOST-OF
[LAMBDA (X F L1)
(COND
((IGREATERP (SETQ L1 (LENGTH X))
200) (* Ranomly sample from X, until timer
runs out or:)
(MOST-OF (RAND-SUBSET X)
F))
((ILESSP L1 (ADD1 (RMUL (LENGTH (SUBSET X F))
3 2])
(MULT-STRUC-PAIR
[LAMBDA (E)
(AND (APPLY* (QUOTE DEFN)
(QUOTE MULT-STRUC)
(CAR E))
(APPLY* (QUOTE DEFN)
(QUOTE MULT-STRUC)
(CADR E])
(NCONCB
[LAMBDA (B P X G)
(SETQ G (GETB B P))
(COND
((NULL X)
G)
(G (NCONC G (SET-DIFFER2 X G)))
((SETB B P X])
(NEWNAME
[LAMBDA (N N2 I)
(COND
((NOT (IS-CON N))
N)
((SETQ N2 N)
(FOR I FROM 1 TO 20 UNTIL (NOT (IS-CON N2)) DO (SETQ N2 (GLUE N I)))
N2)
(T (CPRIN1 0 CRLF CRLF "NEWNAME can't create a new name out of " N DCR "ERROR!!!" CRLF)
(HELP "Type in new name"])
(NOT-USED-YET
[LAMBDA (C)
(NOT (USED-YET C CS-B])
(ONE-ISA
[LAMBDA (XSET X)
(AND X (CAR (SOME XSET (FUNCTION (LAMBDA (X1)
(ISA X1 X])
(ONE-ISAG
[LAMBDA (XSET X)
(AND X (CAR (SOME XSET (FUNCTION (LAMBDA (X1)
(ISAG X1 X])
(ORD-STRUC-PAIR
[LAMBDA (E)
(AND (APPLY* (QUOTE DEFN)
(QUOTE STRUCTURE)
(CAR E))
(APPLY* (QUOTE DEFN)
(QUOTE STRUCTURE)
(CADR E))
(APPLY* (QUOTE DEFN)
(QUOTE ORD-OBJ)
(CAR E))
(APPLY* (QUOTE DEFN)
(QUOTE ORD-OBJ)
(CADR E])
(ORDINAL
[LAMBDA (N)
(SELECTQ (IREMAINDER N 10)
(1 (QUOTE st))
(2 (QUOTE nd))
(3 (QUOTE rd))
(QUOTE th])
(OSET
[NLAMBDA X
(CONS (QUOTE OSET)
X])
(OUTA
[LAMBDA (L)
(* This fn takes a list L nad transforms it so that it can be appended onto a list of the form
(AND x y z) and not waste time doing an extra AND)
(COND
((EQ L T)
NIL)
((OR (NLISTP L)
(NEQ (CAR L)
(QUOTE AND)))
(LIST L))
(T (CDR L])
(PAD
[LAMBDA (W X W2)
(PRIN1 W)
(PAD1 W X)
(PRIN1 W2)
(TERPRI])
(PAD1
[LAMBDA (W X)
(DOTS (IDIFFERENCE X (NCHARS W])
(PADI
[LAMBDA (W X W2)
(PRIN1 TAB)
(PRIN1 W)
(PAD1 W (IDIFFERENCE X 6))
(PRIN1 TAB)
(PRIN1 W2)
(TERPRI])
(PAIR
[NLAMBDA X
(CONS (QUOTE PAIR)
X])
(PGET
[LAMBDA (P B)
(MAPCONC [RIPPLE B (CAR (GETP P (QUOTE CENT]
(QUOTE GETB-P-C])
(PICK-CAND
[LAMBDA NIL
(PROG NIL
P1 (COND
((ILESSP (CSINT CANDS)
DO-THRESH)
(CPRIN1S (IDIFFERENCE 10 SEENCANDS)
CRLF No Cand on (QUOTE CANDS) is good enuf DCR)
(SWHY (IDIFFERENCE 10 SEENCANDS)
(No Cand has estimated interest value above Do-thresh, which is (@ DO-THRESH)
, so AM both looks for new Cands and also reduces Do-thresh))
(DE-THRESH)
(FIND-NEW-CANDS)
(GO P1)))
(CPRIN1S 5 CRLF)
(M2)
(SETQ CVAL NIL)
[COND
((DREMOVE CAND CANDS))
((SETQ CANDS (LIST CAND-TAIL]
(COND
((RECENTLY-TRIED CAND)
(CPRIN1S (IDIFFERENCE 8 SEENCANDS)
CRLF AM recently tried this same Cand COMMA so let APOS skip it now DCR)
(SWHY (IDIFFERENCE 8 SEENCANDS)
(AM just did (CACT CAND)
recently, and it isn't so interesting now that we should repeat it either now or
in the near future))
(SETQ DO-THRESH (SUB1 DO-THRESH))
(GO P1))
((AND (SETQ CS-OP (COP CAND))
(SETQ CS-B (CB CAND))
(SETQ CS-P (CP CAND))
(ENSURE-TOP))
(SETQ CS-INT (CINT CAND))
(SETQ CS-WHY (CWHY CAND))
(SETQ CS-ACT (CACT CAND))
(SETQ GEXISTING (GETB CS-B CS-P))
(SETQ CORG (COUNT GEXISTING))
(SETQ ORIG-EMP (NULL GEXISTING))
(CPRIN1 (IDIFFERENCE 10 SEENCANDS)
CRLF CRLF TAB Beginning SPACE GCNT (ORDINAL GCNT)
SPACE cycle DCR)
(RETURN CAND)))
(GO P1])
(POR
[LAMBDA (P B BA1 BA2 BA3 BA4 RS)
[SETQ RS (DREVERSE (RIPPLE-SIMULT B (GETP P (QUOTE CENT]
(SOME-EBP RS P BA1 BA2 BA3 BA4])
(PRINES
[LAMBDA (C1)
(PRIN1 (ENGN C1))
(PRIN1 SPACE])
(PRINICE
[LAMBDA (L)
(MAPC L (FUNCTION (LAMBDA (Z)
(CPRIN1 1 CRLF TAB Z])
(PRUNABLE
[LAMBDA (C)
(NOT (ILESSP INTHRESH (CINT C])
(PRUNE
[LAMBDA (N) (* We may only want to save the first N
cands; then add at the end something
like: (RPLACD (FNTH CANDS 50) NIL))
(RPLACD (SOME CANDS (QUOTE PRUNABLE])
(PSUF
[LAMBDA (P B BA1 BA2 BA3 BA4 RS C1 PP)
(SETQ C1 (GETP P (QUOTE CENT)))
(AND (SETQ RS (RIPPLE-SIMULT B C1))
(SETQ PP P)
(OR (AND BA1 (FMEMB P STRATEGY-PARTS)
(FMEMB BA1 FACETS)
(SETQ PP BA1)
[SETQ RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(IS-CON-L (GLUE R BA1]
[NCONC RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(RIPPLE-SIMULT R C1]
(SETQ RS (INTERSECTION RS RS)))
T)
(OR (SETQ GEXISTING (INIT-PART B PP))
T)
(NCONCB B PP (NCONC (SETQ P (GETHASH P SUF1))
(MAPCONC RS (QUOTE APPLYB-P))
(SETQ P (GETHASH P SWSUF))
(MAPCONC (DREVERSE RS)
(QUOTE APPLYB-P])
(PUTB
[LAMBDA (B P Q)
(COND
(Q (PUT B P Q))
(T (REMPROP B P])
(PXEQ
[LAMBDA (P B BA1 BA2 BA3 BA4 RS C1 PP)
(SETQ C1 (GETP P (QUOTE CENT)))
(AND (SETQ RS (RIPPLE-SIMULT B C1))
(SETQ PP P)
(OR (AND BA1 (FMEMB P STRATEGY-PARTS)
(FMEMB BA1 FACETS)
(SETQ PP BA1)
[SETQ RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(IS-CON-L (GLUE R BA1]
[NCONC RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(RIPPLE-SIMULT R C1]
(SETQ RS (INTERSECTION RS RS)))
T)
(OR (SETQ GEXISTING (INIT-PART B PP))
T)
(NCONCB B PP (MAPCONC RS (QUOTE APPLYB-P])
(Q
[NLAMBDA (X)
(LIST (QUOTE QUOTE)
X])
(RAISE-WORTH
[LAMBDA (B)
(RPLACA (GETB B (QUOTE WORTH))
(COND
[(GETB B (QUOTE GWORTH))
(ADD1 (CAR (GETB B (QUOTE WORTH]
(T [PUT B (QUOTE GWORTH)
(APPEND (GETB B (QUOTE WORTH]
(AVG2 900 (CAR (GETB B (QUOTE WORTH])
(RAND-ACEX-MEMB
[LAMBDA (B)
(RANDQMEMB (APPLY* (QUOTE ACEX)
B])
(RAND-CON
[LAMBDA NIL
(SETQ RANC (GETHASH RANC CIRC])
(RAND-INCRB
[LAMBDA (B P X RS) (* A NULL RESULT MEANS THAT X WAS NOT
ADDED TO B.P)
(COND
((MEMBER X (GETB B P))
(CPRIN1S 87 X was already a (ENGN P) of B DCR))
((NULL X)
(CPRIN1S 86 How could I add Nil to (ENGN P) of B QUES CRLF))
((ILESSP (RAND 0 (LENGTH (GETB B P)))
RS)
(CPRIN1S 79 Actually added X to (ENGN P) of B DCR)
(SETB B P (NCONC1 (GETB B P)
X)))
(T (CPRIN1S 30 Could have added X to (ENGN P) of B DCR])
(RAND-MEMB
[LAMBDA (S)
(AND (LISTP S)
(CAR (FNTH S (RAND 1 (LENGTH S])
(RAND-OBJ
[LAMBDA NIL
(CAR (OR (SETQ OBJX (CDR OBJX))
(SETQ OBJX (EXS OBJECT])
(RAND-PERMUTE
[LAMBDA (L L1 M)
(ANY1OF [AND (SETQ L (COPY L))
(CONS (SETQ L1 (RAND-MEMB L))
(RAND-PERMUTE (DREMOVE L1 L]
(PROGN (SETQ M (LIST T))
[MAPC L (FUNCTION (LAMBDA (L1)
(ATTACH L1 (FNTH M (RAND 1 (LENGTH M]
(CDR (DREVERSE M])
(RAND-PRED
[LAMBDA NIL
(ZEROP (RAND 0 1])
(RAND-SUBSET
[LAMBDA (S)
(SUBSET S (QUOTE RAND-PRED])
(RAND-THING
[LAMBDA NIL
(APPLY (GETHASH RANF CIRC])
(RAND-USER
[LAMBDA NIL
(SETQ RANU (GETHASH RANU CIRC])
(RANDQMEMB
[LAMBDA (S)
(AND (LISTP S)
(KWOTE (CAR (FNTH S (RAND 1 (LENGTH S])
(RCON
[LAMBDA NIL
(PROG (N)
L1 (SETQ N (RATOM)) (* To get real snazzy, the system should
fill in unambiguous letters wrt known
concept names)
(COND
((IS-CON N)
(RETURN N))
(T (CPRIN1S -1 CRLF No COMMA no EXCLAIM TAB Type in the name of a concept DOT DOT DOT SPACE)
(GO L1])
(REBB
[LAMBDA (X BA1 BA2 BA3 BA4 BA5 BA6) (* This function is used to REBind the
BAi's; e.g., if their order changes,
after untangling, etc.)
(EVAL X])
(RECENTLY-TRIED
[LAMBDA (C)
(SASSOC (CACT C)
PAST])
(RECTANGLE
[LAMBDA (X1 X2 Y1 Y2)
(COND
((IGREATERP X1 X2)
(SWITCH X1 X2)))
(COND
((IGREATERP Y1 Y2)
(SWITCH Y1 Y2)))
(FOR I1 FROM X1 TO X2 JOIN (FOR I2 FROM Y1 TO Y2 COLLECT (PACK (LIST (QUOTE R)
I1
(QUOTE -)
I2])
(REM-ALLEV
[LAMBDA (X L)
(COND
((NLISTP L)
L)
((MAPCAR (DREMOVE X L)
(FUNCTION (LAMBDA (Z)
(REM-ALLEV X Z])
(REM-ONCE
[LAMBDA (X L)
(ANY1OF (NCONC (LDIFF L (FMEMB X L))
(CDR (FMEMB X L)))
(COND
((NULL L)
NIL)
((EQ (CAR L)
X)
(CDR L))
(T (CONS (CAR L)
(REM-ONCE X (CDR L])
(RENAME2BS
[LAMBDA (A B A1 B1) (* A is new, B is old)
(CREATEB A)
(SETQ A1 (ENGN A))
(SETQ B1 (GETHASH B HCON))
[MAPC CONCEPTS (FUNCTION (LAMBDA (C)
(COND
((EQ B1 (GETHASH C HCON))
(PUTHASH C A HCON)
(PUT C (QUOTE ENGN)
A1]
(RPLACD A (CDR B))
(SETTOPVAL A (GETTOPVAL B))
(PUTD A (GETD B))
(INCRB A (QUOTE IDEN)
(LIST A B])
(RIGHT-STRUC
[LAMBDA (S)
(OR (ISA (CAR S)
(QUOTE ANY-STRUC))
(ISAG (QUOTE ANY-STRUC)
(CAR S])
(RIPPLE
[LAMBDA (B DIR) (* Consider saving the
last B, P, Value to
reuse if the same)
(PROG ((NEW (LIST B))
(OLD (LIST B)))
L1 (NCONC NEW (SETQ
OLD (DSET-DIFF [MAPCONC
OLD (FUNCTION (LAMBDA (A1)
(APPEND (GETB A1 DIR]
NEW)))
(COND
(OLD (GO L1))
((RETURN NEW])
(RIPPLE-L
[LAMBDA (OLD DIR)
(PROG (NEW)
(SETQ NEW (APPEND OLD))
L1 (NCONC NEW (SETQ OLD (DSET-DIFF [MAPCONC OLD (FUNCTION (LAMBDA (A1)
(APPEND (GETB A1 DIR]
NEW)))
(COND
(OLD (GO L1))
((RETURN NEW])
(RIPPLE-S2
[LAMBDA (B DIR1 DIR2)
(PROG ((NEW (LIST B))
(OLD (LIST B)))
L1 [NCONC NEW (SETQ OLD (ATOM-INT (DSET-DIFF [NCONC [MAPCONC OLD (FUNCTION (LAMBDA (A1)
(APPEND (GETB A1 DIR1]
(MAPCONC OLD (FUNCTION (LAMBDA (A1)
(APPEND (GETB A1 DIR2]
NEW]
(COND
(OLD (GO L1))
((RETURN NEW])
(RIPPLE-UNTIL
[LAMBDA (ATYPE P PRED)
(PROG (OLD (NEW (LIST ATYPE))
RVAL)
(GO L2)
L1 (SETQ NEW (DSET-DIFF (ATOM-INT (MAPCONC NEW (QUOTE GETB-P-C))) OLD))
L2 (COND
([SETQ RVAL (SOME NEW (FUNCTION (LAMBDA (B) (* Note that the argument PRED must be a
predicate using the free variable B)
(EVAL PRED]
(RETURN (CAR RVAL)))
(NEW (SETQ OLD (NCONC OLD NEW))
(GO L1))
(T (RETURN NIL])
(RIPPLE-UNTIL-P
[LAMBDA (B DIR P RVAL)
(OR (GETB B P)
(PROG ((NEW (LIST B))
(OLD (LIST B)))
L1 (OR (SETQ OLD (ATOM-INT (DSET-DIFF [MAPCONC OLD (FUNCTION (LAMBDA (A1)
(APPEND (GETB A1 DIR]
NEW)))
(RETURN NIL))
[COND
((SETQ RVAL (SOME OLD (QUOTE GETB-P)))
(RETURN (GETB (CAR RVAL)
P]
(NCONC NEW OLD)
(GO L1])
(RMUL
[LAMBDA (AMUL IMUL JMUL)
(IQUOTIENT (ITIMES AMUL IMUL)
JMUL])
(RNUM
[LAMBDA (N)
(COND
((NUMBERP (SETQ N (RATOM)))
N)
(T (PRIN1 "No, no!! Type a number...")
(RNUM])
(RPLACINT
[LAMBDA (X Y)
(RPLACA (CDR X)
Y])
(RUN-ANAS
[LAMBDA (L)
(MAPCONC L (QUOTE RUN1ANA])
(RUN-OPS-TO-GET
[LAMBDA (B TKNT OPS1 CC) (* First, let OPS1 be thes et of all
operators mapping into B)
(* If IN-RAN-OF worked clearly, we could
use that, perhaps)
(OR OPS1 [MAPC (EXS OPERATION)
(FUNCTION (LAMBDA (OP)
(COND
((AND [EQ B (LASTELE (ANY1OFE (GETB OP (QUOTE D-R]
(EVERY [ALL-BUT-LAST (ANY1OFE (GETB OP (QUOTE D-R]
(QUOTE ACEX)))
(SETQ OPS1 (CONS OP OPS1]
(NOT OPS1)
(CPRIN1S 7 CRLF CRLF AM will now try to produce examples of B
by running the following operations COLON CRLF TAB OPS1 DCR CRLF) (* NOTE THE USE OF EXS INSEAD OF ACEX)
) (* Next, apply each one, until time runs
out)
(OR TKNT (SETQ TKNT (IPLUS (CLOCK 2)
(RMUL CS-INT (CAR (GETB B (QUOTE WORTH)))
33)
3000)))
(OR CC (SETQ CC 0))
(NCONC [MAPCAR OPS1 (FUNCTION (LAMBDA (OP)
(EVAL (NCONC (LIST (QUOTE APPLYB)
(KWOTE OP)
(Q ALGS))
(MAPCAR [ALL-BUT-LAST (ANY1OFE (GETB OP (QUOTE D-R]
(QUOTE RAND-ACEX-MEMB]
(COND
((IGREATERP (CLOCK 2)
TKNT)
NIL)
((IGREATERP CC 200)
NIL)
(OPS1 (RUN-OPS-TO-GET B TKNT OPS1 (ADD1 CC])
(RUN1ANA
[LAMBDA (A) (* NOT IN YET)
NIL])
(S-DECODE
[LAMBDA (S)
(GLUE S (QUOTE STRUC])
(SAD2
[LAMBDA (L F SUM)
(SETQ SUM 0) (* Note that we are using IPLUS here)
[MAPC L (FUNCTION (LAMBDA (L1 V1)
(SETQ V1 (EVAL (APPLY* F L1)))
(COND
((NUMBERP V1)
(SETQ SUM (IPLUS SUM V1]
SUM])
(SAD3
[LAMBDA (X Y)
(SETQ X (EVAL X))
(SETQ Y (EVAL Y))
(COND
((NUMBERP X)
(COND
((NUMBERP Y)
(LARGER X Y))
(T X)))
((NUMBERP Y)
Y)
(T 0])
(SADD
[NLAMBDA X (* This is a special Addition function,
which eliminates NIL's before adding the
entries)
(APPLY (QUOTE IPLUS)
(DREMOVE NIL (MAPCAR X (QUOTE EVAL])
(SCDR
[LAMBDA (L)
(COND
((LISTP L)
(CONS (CAR L)
(SORT (APPEND (CDR L])
(SELF
[NLAMBDA (X)
(SET X X])
(SELF-COMPILE
[NLAMBDA (BP C AL)
(SETQ LAPFLG NIL)
(SETQ SVFLG NIL)
(SETQ STRF T)
(COMPILE1 BP (LIST (QUOTE LAMBDA)
(SETQ AL (ARGLIST BP))
C))
(EVAL (CONS BP AL])
(SELF-INT
[LAMBDA (S)
(INTERSECTION S S])
(SET-DIFF
[LAMBDA (L M)
(ANY1OF (PROGN (SETQ L (APPEND L))
[MAPC M (FUNCTION (LAMBDA (M1)
(SETQ L (DREMOVE M1 L]
L)
(SUBSET L (FUNCTION (LAMBDA (L1)
(NOT (FMEMB L1 M])
(SET-DIFFER2
[LAMBDA (L M)
(SUBSET L (FUNCTION (LAMBDA (L1)
(NOT (MEMBER L1 M])
(SET-DIFFERENCE
[LAMBDA (L M)
[MAPC M (FUNCTION (LAMBDA (M1)
(SETQ L (REMOVE M1 L]
L])
(SET-NTH
[LAMBDA (S N X I)
(COND
((FNTH S N)
(CAR (FRPLACA (FNTH S N)
X)))
((CDR S)
(FOR I FROM (ADD1 (LENGTH S)) TO N DO (NCONC1 S 0))
(CAR (FRPLACA (FNTH S N)
X])
(SETB
[LAMBDA (B P Q BP)
[AND (FMEMB P XEQ-PARTS)
Q
[PUTD (SETQ BP (GLUEE B P))
(LIST (QUOTE LAMBDA)
(GETARGS P)
(LIST (QUOTE SELF-COMPILE)
BP
(CONS (GETFNAME P)
Q]
(OR (GETB B P)
(ATTACH (LIST P (CONS BP (GETARGS P)))
(BPFS B]
(PUT B P Q])
(SETBQ
[NLAMBDA (B P Q)
(SETB B P (EVAL Q])
(SIMPLIFY1
[LAMBDA (L STMP STM2)
(COND
((NLISTP L)
L)
[(ISQ L)
(COND
((FMEMB (CADR L)
(LIST T NIL 0 1 2 3 4 5 6 7 8 9))
(CADR L))
((FMEMB (SETQ STMP (SIMPLIFY1 (CADR L)))
(LIST T NIL 0 1 2 3 4 5 6 7 8 9))
STMP)
(T (KWOTE STMP]
[(EQ (CAR L)
(QUOTE AND))
(SETQ STMP (MAPCAR (SELF-INT (CDR L))
(QUOTE SIMPLIFY1)))
(SETQ STMP (DREMOVE T (SELF-INT STMP)))
(COND
((FMEMB NIL STMP)
NIL)
([SOME STMP (FUNCTION (LAMBDA (S)
(MEMBER (LIST (QUOTE NOT)
S)
STMP]
NIL)
((SELECTQ (LENGTH STMP)
(0 T)
(1 (CAR STMP))
(ATTACH (QUOTE AND)
STMP]
[(EQ (CAR L)
(QUOTE OR))
(SETQ STMP (MAPCAR (SELF-INT (CDR L))
(QUOTE SIMPLIFY1)))
(SETQ STMP (DREMOVE NIL (SELF-INT STMP)))
(COND
((FMEMB T STMP)
T)
([SOME STMP (FUNCTION (LAMBDA (S)
(MEMBER (LIST (QUOTE NOT)
S)
STMP]
T)
((SELECTQ (LENGTH STMP)
(0 NIL)
(1 (CAR STMP))
(ATTACH (QUOTE OR)
STMP]
[(OR (EQ (CAR L)
(QUOTE EQUAL))
(EQ (CAR L)
(QUOTE EQ))
(ISAS (CAR L)
(QUOTE OBJ-EQUAL)))
(COND
((EQUAL (CADR L)
(CADDR L))
T)
([EQUAL (SETQ STMP (SIMPLIFY1 (CADR L)))
(SETQ STM2 (SIMPLIFY1 (CADDR L]
T)
((OR (NLISTP STMP)
(NLISTP STM2))
(LIST (CAR L)
STMP STM2))
((EQUAL (CDR STMP)
(CDR STM2)) (* When does f (x) =g
(x) ?)
(LIST (CAR L)
STMP STM2))
((EQUAL (CAR STMP)
(CAR STM2)) (* When does f (x) =f
(y) ?)
(LIST (CAR L)
STMP STM2))
(T (LIST (CAR L)
STMP STM2]
((EQ (CAR L)
(QUOTE PROGN))
(SETQ STMP (MAPCAR (DREVERSE (SELF-INT (CDR L)))
(QUOTE SIMPLIFY1)))
[SETQ STMP (DREVERSE (CONS (CAR STMP)
(SELF-INT (SUBSET (CDR STMP)
(QUOTE LISTP]
(SELECTQ (LENGTH STMP)
(0 NIL)
(1 (CAR STMP))
(ATTACH (QUOTE PROGN)
STMP)))
[(EQ (CAR L)
(QUOTE NOT))
(SETQ STMP (SIMPLIFY1 (CADR L)))
(COND
((NUMBERP STMP)
NIL)
((EQ STMP T)
NIL)
((EQ STMP NIL)
T)
((ATOM STMP)
(LIST (QUOTE NOT)
STMP))
((FMEMB (CAR STMP)
CONSTRUCTIVE-OPS)
NIL)
((EQ (CAR STMP)
(QUOTE NOT))
(CDR STMP))
[[AND (EQ (CAR STMP)
(QUOTE OR))
(EVERY (CDR STMP)
(FUNCTION (LAMBDA (Z)
(EQ (CAR Z)
(QUOTE NOT]
(ATTACH (QUOTE AND)
(MAPCAR (CDR STMP)
(QUOTE CADR]
([AND (EQ (CAR STMP)
(QUOTE AND))
(EVERY (CDR STMP)
(FUNCTION (LAMBDA (Z)
(EQ (CAR Z)
(QUOTE NOT]
(ATTACH (QUOTE OR)
(MAPCAR (CDR STMP)
(QUOTE CADR]
((AND (FMEMB (CAR L)
(QUOTE (MEMBER FMEMB MEMB)))
(EQUAL [CAR (SETQ STMP (SIMPLIFY1 (CADDR L]
(QUOTE LIST)))
(SELECTQ (LENGTH (SETQ STMP (SELF-INT STMP)))
((0 1)
NIL)
[2 (* So STMP is of the form
(LIST x))
(SIMPLIFY1 (LIST (QUOTE EQUAL)
(CADR L)
(CADR STMP]
(LIST (CAR L)
(SIMPLIFY1 (CADR L))
STMP)))
((EQ (CAR L)
(QUOTE SELECTQ))
(SETQ STMP (SIMPLIFY1 (LASTELE L)))
[SETQ L (CONS (QUOTE SELECTQ)
(CONS (SIMPLIFY1 (CADR L))
(NCONC1 [SUBSET [SELF-INT (MAPCAR (CDDR (ALL-BUT-LAST L))
(FUNCTION (LAMBDA (Z)
(SELF-INT (CONS (CAR Z)
(MAPCAR (CDR Z)
(QUOTE SIMPLIFY1]
(FUNCTION (LAMBDA (Z)
(OR (CDDR Z)
(NOT (EQUAL (CADR Z)
STMP]
STMP] (* So we should not recursively call
Simplify1 on any existing parts of L)
[MAP (CDDR (ALL-BUT-LAST L))
(FUNCTION (LAMBDA (Z)
(MAPC (CDR Z)
(FUNCTION (LAMBDA (ZZ)
(AND (EQUAL (CDAR Z)
(CDR ZZ))
(RPLACA (CAR Z)
(LAPP (CAAR Z)
(CAR ZZ]
[MAP (APPEND (CDDR (ALL-BUT-LAST L)))
(FUNCTION (LAMBDA (Z)
(MAPC (CDR Z)
(FUNCTION (LAMBDA (ZZ)
(AND (EQUAL (CDAR Z)
(CDR ZZ))
(DREMOVE ZZ L]
[COND
((NULL (CDDDR L))
(SETQ L (CADDR L]
L)
[(MATCH L WITH ('CONS ('CAR STMP←&)
('CDR STM2←&)))
(SETQ STMP (SIMPLIFY1 STMP))
(SETQ STM2 (SIMPLIFY1 STM2))
(COND
((EQUAL STMP STM2)
STMP)
(T (LIST (QUOTE CONS)
(SIMPLIFY1 (LIST (QUOTE CAR)
STMP))
(SIMPLIFY1 (LIST (QUOTE CDR)
STM2]
(T (MAPCAR L (QUOTE SIMPLIFY1])
(SIMULT-SATISFY
[LAMBDA (GLIST BA BN SVAL TST)
[COND
[(MATCH GLIST WITH (('ISA BA←&
@[LAMBDA (Z)
(FMEMB Z BA-LIST]
('QUOTE BN←&@IS-CON))
(&@[LAMBDA (Z)
(NOT (FMEMB Z (LIST (QUOTE ISA)
(QUOTE ARE-EQUIV]
$)))
(SETQ TST (SUBST (QUOTE X)
BA
(CADR GLIST)))
(SETQ SVAL (OR (ANY1OF-SATISFYING (APPLY* (QUOTE EXS-BDY)
BN)
TST)
(ANY1OF-SATISFYING (APPLY* (QUOTE EXS)
BN)
TST]
(T (MAPC GLIST (FUNCTION (LAMBDA (G XPR BN2)
(COND
[[MATCH G WITH ('ISA BA←&@[LAMBDA (Z)
(FMEMB Z BA-LIST]
BN←&@(LAMBDA (Z)
(IS-CON (SETQ BN2 (CAR (ERRORSET Z]
(SETQ TMP8 (APPLY* (QUOTE ACEX)
BN2))
(OR (ISA (EVAL BA)
BN2)
(SET BA (RAND-MEMB TMP8]
((MATCH G WITH ('ARE-EQUIV BA←&@[LAMBDA (Z)
(MATCH (UNPACK Z) WITH ('B 'A &@NUMBERP]
XPR←&)) (* We should check that XPR doesn't
involve any BAi's which haven't already
been ISA-checked and/or bound)
(SETQ SVAL (SET BA (CAR (ERRORSET XPR]
(* Actually, to be truly "simult", we must re-check our earlier goals after each new one is
satisfied, and perhaps we should initially select the "hardest" one to satisfy first, etc,)
(COND
(SVAL (LIST (COND
((ISA CS-B (QUOTE ACTIVE))
(NCONC1 (MAPCAR (GARGS CS-B)
(QUOTE EVAL))
SVAL))
(T SVAL])
(SMALLER
[LAMBDA (A B)
(COND
((LESSP A B)
A)
(B])
(SOFS
[LAMBDA (S1 S2) (* Find a Being of the form S1-of-S2s)
(IS-CON (PACK (LIST (INV-STYP S1)
(QUOTE -OF-)
(INV-STYP S2)
(QUOTE S])
(SOFS-DECODE
[LAMBDA (A)
(AND (MATCH (UNPACK A) WITH (GTEMP372←$
'- 'O 'F '- GTEMP373←$
'S))
(SETQ GTEMP372 (PACK GTEMP372))
(SETQ GTEMP373 (PACK GTEMP373))
(LIST (S-DECODE GTEMP372)
(S-DECODE GTEMP373])
(SOME-EBP
[LAMBDA (L P BA1 BA2 BA3 BA4)
(ANY1OF [SOME L (FUNCTION (LAMBDA (L1)
(AND (IS-CON L1)
(SETQ GSOME-VAL (APPLYB L1 P BA1 BA2 BA3 BA4))
(SETQ GSOME-ELE L1]
(PROG NIL
L2 (COND
([OR (NLISTP L)
(NOT (IS-CON (CAR L]
(RETURN NIL))
((SETQ GSOME-VAL (APPLYB (CAR L)
P BA1 BA2 BA3 BA4))
(SETQ GSOME-ELE (CAR L))
(RETURN GSOME-VAL)))
(SETQ L (CDR L))
(GO L2])
(SOMEE
[LAMBDA (XSET FN)
(PROG (V)
L1 (COND
((SETQ V (APPLY* FN (CAR XSET)))
(RETURN V))
((SETQ XSET (CDR XSET))
(GO L1))
((RETURN NIL])
(SORD
[LAMBDA (X Y)
(AND (ALPHORDER X Y)
(OR (NLISTP X)
(NLISTP Y)
(EQUAL X Y)
(COND
((EQUAL (CAR X)
(CAR Y))
(SORD (CDR X)
(CDR Y)))
((SORD (CAR X)
(CAR Y])
(SORTED
[LAMBDA (L)
(EVERY2 L (CDR L)
(QUOTE ALPHORDER])
(SORV
[LAMBDA (N)
(EVAL (APPLY* GIFN (IFEA (CAR (FNTH G-IF N])
(SPECL1RDEF
[LAMBDA (DE REC S ILV EILV TILV TDEF TNAM)
[SETQ GTEMP51 (NEWNAME (SETQ TNAM (GLUE (QUOTE SPEC)
CS-B]
(SETQ GTEMP308 (CINL (GFNAMES S)))
(CPRIN1S 5 TAB AM specializes CS-B into the new concept GTEMP51 COMMA by no longer saying that it suffices
to successfully recurse on the GTEMP308 of the args DCR)
(CPRIN1S 8 i.e. COMMA GTEMP51 will not have a recursive test CRLF like this one COMMA which is present
in CS-B COLON CRLF)
(COND
((IGREATERP VERBOSITY 8)
(PRINICE S)
(TERPRI)))
[SETQ TDEF (DSUBST (LIST (QUOTE PROG1)
NIL
(LIST (QUOTE COMMENT) in CS-B this is S))
(QUOTE ZCOM)
(DSUBST GTEMP51 CS-B (SUBST (QUOTE ZCOM)
S DE]
(COND
([AND (NEQ GTEMP51 TNAM)
(SETQ GTEMP60 (CAR (SOME (GETB CS-B (QUOTE SPEC))
(FUNCTION (LAMBDA (G)
(MEMBER TDEF (GETB G (QUOTE DEFN]
(SWHY 7 (The proposed new specialization turned out to be identical to (@ GTEMP60)))
(CPRIN1S 7 TAB Failed DCR))
(T (CREATEB GTEMP51)
(INCRB GTEMP51 (QUOTE DEFN)
TDEF)
[INCRB GTEMP51 (QUOTE TIES)
(LIST CS-B (LIST DEFN (SPLIST GTEMP51 does no recursing on GTEMP308]
(* Note the format assumed for TIES part
entry is (other-B-name
(part1name (relnship1) ...
(relnship-n)) (part2name...)))
[COND
[(ISA CS-B (QUOTE ACTIVE))
[INCRB GTEMP51 (QUOTE D-R)
(APPEND (CAR (GETB CS-B (QUOTE D-R]
(COND
((ISA CS-B (QUOTE PREDICATE)) (* IN special, we want to see if Genl
(CS-b) are also Genl
(Gtemp51); eg., so that ISA will work
right)
[INCRB GTEMP51 (QUOTE ALGS)
(LIST (QUOTE TYPE)
(QUOTE TRANSFORM)
(QUOTE REDUCING-TO)
(QUOTE SELF)
(LIST (QUOTE APPLYB)
(KWOTE GTEMP51)
(Q DEFN)
(QUOTE BA1)
(QUOTE BA2)
(QUOTE BA3)
(QUOTE BA4]
(INCRB (QUOTE PREDICATE)
(QUOTE EXS)
GTEMP51)
(INCRB GTEMP51 (QUOTE UP)
(QUOTE PREDICATE)))
(T (INCRB (QUOTE ACTIVE)
(QUOTE EXS)
GTEMP51)
(INCRB GTEMP51 (QUOTE UP)
(QUOTE ACTIVE]
(T (INCRB GTEMP51 (QUOTE UP)
(QUOTE ANYB))
(ADD-CANDS (LIST (LIST (LIST (QUOTE FILLIN)
GTEMP51
(QUOTE UP))
(ADD1 (OR EILV (AVG2 ILV CS-INT)))
(LIST (SPLIST While working
on the specialization GTEMP51
of CS-B COMMA AM could not trivially determine what the (QUOTE UP)
part should be]
(INCRB GTEMP51 (QUOTE GENL)
CS-B)
(INCRB CS-B (QUOTE SPEC)
GTEMP51)
(SETB GTEMP51 (QUOTE WORTH)
(RPLACINT (APPEND (GETB CS-B (QUOTE WORTH)))
(AVG2 ILV 600) (* We probably want to indicate that
Gtemp51 has very tenuous grounds for
existence, and it should be justified
quickly or killed)
))
[ADD-CANDS (LIST (LIST (LIST (QUOTE FILLIN)
GTEMP51
(QUOTE EXS))
(OR EILV (AVG2 ILV CS-INT))
(LIST (SPLIST The specialization GTEMP51
of CS-B is relatively new and has no exs of its own yet]
(* Sometime we should check that the new
Bs are not just equal to some
already-existing one, either trivially
(syntactically) or by func equiv)
GTEMP51])
(SPECLIZE-RECDEF
[LAMBDA (D DBOD BASE REC ILV SPL)
(SETQ DBOD (CAR (FLAST D)))
(COND
[[OR (MATCH DBOD WITH ('OR BASE←$
REC←&))
(MATCH DBOD WITH ('COND BASE←$
(REC←&)))
(MATCH DBOD WITH ('COND BASE←$
('T $ REC←&]
(CPRIN1 6 CRLF " Considering speclizing a recursive defn of " CS-B CRLF)
(SETQ ILV (DOTPROD (GETB CS-B (QUOTE WORTH))
(LIST .7 .2)))
(COND
((ILESSP ILV DO-THRESH)
(CPRIN1 7 TAB "Stopped")
(CPRIN1 8 TAB " because not interesting enuf")
(SWHY 7 (The estimated interest level for (@ CS-B)
right now is only (@ ILV)
,which is way below my threshhold
for doing anything:(@ DO-THRESH)))
(CPRIN1 7 DCR))
((SELECTQ (CAR REC)
(OR (CPRIN1 8 TAB "Will try to remove a disjunct")
(CPRIN1 17 " from: ")
(CPRIN1 17 (PRINICE REC))
(CPRIN1 8 DCR)
[SETQ SPL (SUBSET (CDR REC)
(FUNCTION (LAMBDA (Z)
(MATCH Z WITH ('APPLYB ('QUOTE =CS-B)
('QUOTE 'DEFN)
$]
(SELECTQ (LENGTH SPL)
(0 (CPRIN1 8 TAB "Failed. No member of This recursive defn is a simple call on " CS-B
" itself" DCR TAB
"Later, I may check whether this defn is really recursive or not" DCR))
(1 (CPRIN1 8 "Failed. Only one simple recursive call on itself. No easy speclz" DCR))
(PROGN (CPRIN1 9 TAB (LENGTH SPL)
" possible disjuncts to choose from" DCR)
[SETQ GTEMP51 (MAPCAR SPL (FUNCTION (LAMBDA (S)
(SPECL1RDEF D REC S ILV (IDIFFERENCE CS-INT
(LENGTH SPL]
(CPRIN1S 8 CRLF If any of GTEMP51 ever seems
to be too specialized COMMA AM will consider disjoining it
with other members of that set DCR)
[MAPC GTEMP51
(FUNCTION (LAMBDA (Z)
(SUGGEST Z (QUOTE GENL)
(LIST (QUOTE APPLYB)
(Q DISJOIN)
(Q ALGS)
(KWOTE (REMOVE Z GTEMP51))
(SPLIST An intermediate level
of specialization COMMA between CS-B
and Z COMMA would be
to Disjoin Z with some of these COLON
(REMOVE Z GTEMP51]
GTEMP51)))
(AND (CPRIN1 8 TAB "Will try to add a new conjunct")
(CPRIN1 17 " from: " REC)
(CPRIN1 8 DCR) (* This isnt in yet)
(CPRIN1 8 "ISNT IN YET. FAIL." CRLF))
(CPRIN1 9 TAB "Can't go on: can only handle AND and OR types of recursive defns" CRLF
"This recursive defn is: " REC CRLF]
((CPRIN1 10 " I wanted to speclize the recursive defn of " CS-B COMMA CRLF D COMMA CRLF TAB
"but this doesn't match any pattern I know" DCR])
(SPECLIZE-TRANSDEF
[LAMBDA (D SSET SFN SNEW CNTS EMAX NINT DNEW)
(SETQ D (COPY D))
(SETQ GLOC-NOT NIL) (* Arrange the following options in some
order dynamically perhaps;
e.g., random order)
(COND
([AND (SETQ GTEMP331 (LLOCATE (QUOTE SOME)
D T))
(SETQ SFN (CADDR GTEMP331))
[SETQ SSET (CAR (SYM-XEQ (CADR GTEMP331]
(SETQ DNEW (SUBLIS (LIST (CONS (QUOTE XFN)
SFN)
(CONS (QUOTE XSET)
(QUOTE SSET)))
GD-TEST))
(SETQ SSET (MAPCAR SSET (FUNCTION (LAMBDA (X)
(CONS 0 X]
[MAPC (APPLY* (QUOTE ACEX)
CS-B)
(COND
[(ISA CS-B (QUOTE ACTIVE))
(FUNCTION (LAMBDA (E BA1 BA2 BA3 BA4 BA5)
(MAP2CAR (GARGS CS-B)
E
(QUOTE SETQ))
(EVAL DNEW]
(T (FUNCTION (LAMBDA (BA1)
(EVAL DNEW]
[SETQ EMAX (CADR (MAXI SSET (QUOTE CAR] (* The extra argument T in LLOCATE means
we must be careful about the parity of
the NOT's we are inside when we locate
SOME)
(* Then we can specialize by picking a particular element of the set S and demanding it satisfy f,
where (SOME S f) is in the original defn D)
[SETQ SNEW (SIMPLIFY1 (LIST (QUOTE APPLY*)
SFN
(KWOTE (CDR EMAX]
(DSUBST SNEW GTEMP331 D)
(CPRIN1S 7 CRLF AM specializes the Transform defn of CS-B)
(CPRIN1S 8 by replacing CRLF GTEMP331 CRLF by CRLF SNEW)
(CPRIN1S 7 DCR)
[SETQ NINT (AVG2 (CAR (GETB CS-B (QUOTE WORTH)))
(RMUL 1000 (CAR EMAX)
(SAD2 SSET (QUOTE CAR]
(LINN (BLOWUP-NEW-SPEC D NINT)))
(T
(* Right now no other methods. SOme possibilities include: Replace the Some by an Every intead of a
particular element; If the Llocate finds an EVERY inside a NOT, maybe replace it by a SOME or a
particular element)
NIL])
(SPLIST
[NLAMBDA CPARG
(MAPCAR CPARG (FUNCTION (LAMBDA (Z)
(COND
((NOT (ATOM Z))
(EVAL Z))
((NEQ (GETTOPVAL Z)
(QUOTE NOBIND))
(EVAL Z))
((NEQ (EVALV Z)
(QUOTE NOBIND))
(EVALV Z))
(T (SETTOPVAL Z Z)
Z])
(SSORT
[LAMBDA (Z)
(SORT (CDR Z)
(QUOTE SORD])
(STACK-BS
[LAMBDA (BL)
[MAPDL (FUNCTION (LAMBDA (N)
(COND
((IS-CON N)
(SETQ BL (CONS N BL]
BL])
(START
[LAMBDA NIL
(INIT-VARS)
(GET-NAMES)
(CPRIN1S 0 CRLF Almost ready
to enter AM's main loop COMMA FIRSTNAME DCR)
(BRIEF-U)
(GET-VERBO)
(GET-UCON)
(GET-SEEN)
(GET-WAIT)
[SETQ MAXNAME (IPLUS 99 (ITIMES -3 UCONTROL)
(ITIMES -2 (SMALLER VERBOSITY 6]
(TLOOP)
(CPRIN1S 0 CRLF Again COMMA)
(START])
(STRUC
[NLAMBDA X
(CONS (QUOTE STRUC)
X])
(STRUC-PAIR
[LAMBDA (E)
(AND (ISA (CAR E)
(QUOTE STRUCTURE))
(ISA (CADR E)
(QUOTE STRUCTURE])
(STRUCHECK
[LAMBDA (S)
(AND (LISTP S)
(CONS (CAR S)
(SELECTQ (CAR S)
[CLASS (SORT (SELF-INT (CDR S]
(OSET (SELF-INT (CDR S)))
(BAG (SORT (CDR S)))
(CDR S])
(STRUCTYP?
[LAMBDA (BA1 BA2 BA3)
[SETQ GTEMP3 (CAR (SOME (PROGN (SETQ GTEMP2 (LIST (QUOTE EMPTY-STRUC)
(QUOTE SET-STRUC)
(QUOTE BAG-STRUC)
(QUOTE OSET-STRUC)
(QUOTE LIST-STRUC)))
(OR (AND BA3 (FMEMB BA3 GTEMP2)
(ATTACH BA3 (DREMOVE BA3 GTEMP2)))
GTEMP2))
(FUNCTION (LAMBDA (S) (* Maybe the following is too much to
really go thru)
(OR (FMEMB S (APPLY* (QUOTE UP)
BA2))
(FMEMB BA2 (APPLY* (QUOTE ACEX)
S))
(APPLYB S (QUOTE DEFN)
BA2]
[OR (AND BA3 (NEQ BA3 GTEMP3)
BA2
(SETQ GTEMP1 (APPLY* (QUOTE VIEW)
BA3 BA2 GTEMP3 NIL T))
(SETQ GTEMP3 BA3)
(SETQ BA2 GTEMP1))
(AND (NOT GTEMP3)
(SETQ GTEMP3 (OR BA3 (RAND-MEMB GTEMP2]
BA2])
(STRUCTYPE
[LAMBDA (L ADVI)
(ANY1OF (SELECTQ (CAR L)
(VECTOR (QUOTE LIST-STRUC))
(CLASS (QUOTE SET-STRUC))
(BAG (QUOTE BAG-STRUC))
(OSET (QUOTE OSET-STRUC))
NIL)
(PROGN (STRUCTYP? NIL L ADVI)
GTEMP3])
(SUB-ONCE
[LAMBDA (X Y L Z)
(ANY1OF (COND
[(SETQ Z (FMEMB Y L))
(NCONC (LDIFF L Z)
(CONS X (CDR Z]
(T L))
(COND
((NULL L)
NIL)
((EQ (CAR L)
Y)
(CONS X (CDR L)))
(T (CONS (CAR L)
(SUB-ONCE X Y (CDR L])
(SUBSET-INVOLVING-ONLY
[LAMBDA (XSET V)
[SETQ V (SET-DIFF BA-LIST2 (COND
((ATOM V)
(LIST V))
(T V]
(CONS (QUOTE AND)
(SUBSET XSET (FUNCTION (LAMBDA (X)
(NOT (INTERSECTION V (FLATTEN X])
(SUGGEST
[LAMBDA (B P C)
(* Some advice is rolling in about how to deal with
part P of Being B; namely, we are getting a
pseudo-candidate, C)
(INCRB B (QUOTE AID)
(LIST P C])
(SWHY
[NLAMBDA (I X)
(COND
[(IGREATERP VERBOSITY (EVAL I))
(SETQ GWHY (MAPCAR X (QUOTE INVQ]
(T (SETQ MWHY (MAPCAR X (QUOTE INVQ)))
NIL])
(SWITCH
[NLAMBDA (C1 C2 CTEMP)
(SETQ CTEMP (EVAL C1))
(SET C1 (EVAL C2))
(SET C2 CTEMP])
(SYM-XEQ
[LAMBDA (X)
(COND
[(ATOM X)
(COND
((NEQ (EVALV X)
(QUOTE NOBIND))
(LIST (EVALV X]
((LISTP X)
(SELECTQ (ARGTYPE (CAR X))
((0 2) (* It evals its args)
(AND (EVERY (CDR X)
(QUOTE SYM-XEQ))
(ERRORSET X)))
((1 3) (* It does not eval its args)
(ERRORSET X))
NIL])
(TIMES1000
[LAMBDA (X Y)
(RMUL (EVAL X)
(EVAL Y)
1000])
(TLOOP
[LAMBDA NIL
(CPRIN1 1 CRLF "Entering AM's main loop now" DCR)
(PROG NIL
L1 (PICK-CAND)
(XEQ-CAND)
(OR (UPDATE)
(RETURN GCNT))
(GO L1))
(CPRIN1 0 CRLF "Halting AM's main loop after " GCNT " iterations" DCR TAB "To continue, interrupt and type (TLOOP)"
DCR TAB "To re-start, just sit and wait 10 seconds" DCR TAB "To exit, interrupt and Retfrom(Start)" DCR DCR)
(DISMISS 10000)
GCNT])
(TYPE
[NLAMBDA X
(EVAL (CAR (FLAST X])
(UNFORGETTABLE
[LAMBDA (B P I F ARG1)
(* Each C-SUGGESTS part is ordered: first, when to
definitely reject recognition;
next, when to definitely accept it.
If it accepts, the being decides on part P, interest
level I, function to do to it F, args A, reason W,
and then returns ((F B P . A) I
(W)))
(APPLYB B (QUOTE SUGG)
INTHRESH])
(UNTANGLE-ARGS
[LAMBDA (CUR ULT CBAL PBAL) (* If this takes uptoo much time,
consider a new facet, ARGS, which holds
the dominant reordering if one exists)
(COND
((EQ ULT CUR) (* Actually, we want to stop if ISAG,
ISA, etc.)
CBAL)
((FMEMB (QUOTE COALESCE)
(GETB CUR (QUOTE IN-RAN-OF)))
(COND
([SOME (GETB CUR (QUOTE ALGS))
(FUNCTION (LAMBDA (A)
(MATCH A WITH ('TYPE 'TRANSFORM 'REDUCING-TO GTEMP54←&
('APPLYB & ('QUOTE 'ALGS)
PBAL←$] (* Actually, shouldn't just be SOME, but
rather a careful "best" choice to take
us toward ULT)
(UNTANGLE-ARGS GTEMP54 ULT (SUBPAIR (GARGS CUR)
CBAL PBAL)))
(T CBAL)))
(T (* Other cases will go in here
eventually, besides Coalesings: even
simple Transforms might alter argument
ordering)
CBAL])
(UP-THRESH
[LAMBDA NIL
(SWHY 7 (Average of the old value of Do-thresh (LIST DO-THRESH)
and the interest
of the current Cand
(CINT CAND)))
(CPRIN1S 6 CRLF Do-thresh raised)
(CPRIN1S 8 from DO-THRESH)
[SETQ DO-THRESH (DOTPROD (LIST .7 .3)
(LIST DO-THRESH (SMALLER 1000
(CINT CAND]
(CPRIN1S 7 to DO-THRESH)
DO-THRESH])
(UPDATE
[LAMBDA NIL
(SETQ CTSPAN (IDIFFERENCE (CLOCK 2)
CBEGIN))
[COND
((AND CVAL (NEQ CORG (COUNT CVAL)))
(UP-THRESH)
(EPRIN1S (IDIFFERENCE 3 GCNT)
because this last Cand succeeded COMMA so we raise our hopes DASH DASH
and our standards DASH DASH temporarily)
(CPRIN1S 7 DCR))
(T (SETQ DO-THRESH (SUB1 DO-THRESH]
(SETQ INTHRESH (IN-FACTOR DO-THRESH))
(CPRIN1S 7 CRLF This Cand used (QUOTIENT CTSPAN 1000.0)
cpu seconds DCR)
(CPRIN1 10 CRLF "The final value returned by this candidate was: " CVAL CRLF)
(CPRIN1 6 CRLF)
(PRUNE INTHRESH)
(SETQ PAST (CONS (MAKE-CAND (CACT CAND)
(CINT CAND)
(CWHY CAND)
CVAL)
(DREMOVE (CAR (FLAST PAST))
PAST)))
(DO-KILS)
(INCR ACEXPIRE)
(INCR GCNT])
(USED-YET
[LAMBDA (N B)
(SOME (CDAR (CDDDAR (FNTH G-IF N)))
(FUNCTION (LAMBDA (B1)
(ISAG B B1])
(VECTOR
[NLAMBDA X
(CONS (QUOTE VECTOR)
X])
(XEQ-CAND
[LAMBDA NIL
(CPRIN1 4 CRLF)
(SETQ CBEGIN (CLOCK 2))
(SETQ CVAL (EVAL CS-ACT])
)
(DEFINEQ
(INIT1
[LAMBDA NIL
(CLDISABLE (QUOTE -))
(SETQ MKSWAPSIZE 64)
(SETQQ NOSWAPFNS (SETB GETB UPDATE)) (* Decide later what
these fns are)
(WIDEPAPER NIL)
(RAISE)
[INTERRUPTCHAR 24 (QUOTE (PROGN (TERPRI)
(PRIN1 " *** BACKTRACING:")
(TERPRI)
(AM-BT)
(TERPRI)
(PRIN1 "*** END OF BACKTRACE")
(TERPRI]
(INTERRUPTCHAR 25 (QUOTE (CPRIN1S -1 CRLF (LENGTH CANDS)
Cands COMMA (LENGTH CONCEPTS)
Concepts COMMA Gcnt is GCNT DCR)))
(INTERRUPTCHAR 9 (QUOTE (HANDLE-I-INTERRUPT)))
[INTERRUPTCHAR 26 (QUOTE (PROGN (TERPRI)
(PRIN1 " *** INTEREST ")
(PRIN1 DO-THRESH)
(PRIN1 ", ")
(PRIN1 INTHRESH)
(PRIN1 ", NCANDS=")
(PRIN1 (LENGTH CANDS))
(PRIN1 ", CAND=")
(PRINT CAND]
(TERPRI)
(PRIN1 "YOU PROBABLY WANT TO LOAD IN THE FILE CON6 NOW")
(RANDSET RANDSTATE)
(TERPRI])
(INIT-COMP
[LAMBDA NIL
[COND
((NOT (GETD (QUOTE GETTOPVAL)))
(MOVD (QUOTE CAR)
(QUOTE GETTOPVAL))
(MOVD (QUOTE CDR)
(QUOTE GETPROPLIST))
[PUTD (QUOTE SETTOPVAL)
(QUOTE (LAMBDA (X Y)
(CAR (FRPLACA X Y]
[PUTD (QUOTE SETPROPLIST)
(QUOTE (LAMBDA (X Y)
(CDR (FRPLACD X Y]
[PUTD (QUOTE /SETTOPVAL)
(QUOTE (LAMBDA (X Y)
(CAR (/RPLACA X Y]
[PUTD (QUOTE /SETPROPLIST)
(QUOTE (LAMBDA (X Y)
(CDR (/RPLACD X Y]
(NCONC LISPXFNS (QUOTE ((SETTOPVAL . /SETTOPVAL)
(SETPROPLIST . /SETPROPLIST]
[COND
((NOT (GETD (QUOTE GETFILEPTR)))
(MOVD (QUOTE SFPTR)
(QUOTE GETFILEPTR))
(PUTD (QUOTE SETFILEPTR)
(QUOTE (LAMBDA (FILE PTR)
(PROG1 PTR (SFPTR FILE PTR]
(DEFLIST [QUOTE ((GETTOPVAL ((X)
(CAR X)))
(GETPROPLIST ((X)
(CDR X]
(QUOTE MACRO])
(INIT-C
[LAMBDA (R1)
(MOVD (QUOTE SETB)
(QUOTE SLOW-SETB))
(MOVD (QUOTE OR)
(QUOTE ANY-OF))
(MOVD (QUOTE AND)
(QUOTE EACH1OF))
(MOVD (QUOTE GETP)
(QUOTE FGETB))
(MOVD (QUOTE APPLY*)
(QUOTE APPLYB))
(MOVD (QUOTE GETP)
(QUOTE GETB))
(MOVD (QUOTE GETP)
(QUOTE INIT-PART))
(MOVD (QUOTE APPEND)
(QUOTE ALL-OF))
(MOVD (QUOTE CAR)
(QUOTE IPRED))
(MOVD (QUOTE CAR)
(QUOTE ANY1OFE))
(MOVD (QUOTE CADR)
(QUOTE IDEF))
(MOVD (QUOTE CADR)
(QUOTE PINT))
(MOVD (QUOTE CAAR)
(QUOTE P-OP))
(MOVD (QUOTE CADAR)
(QUOTE P-B))
(MOVD (QUOTE CADDAR)
(QUOTE P-P))
(MOVD (QUOTE CDDDAR)
(QUOTE PARG))
(MOVD (QUOTE CADDR)
(QUOTE PWHY))
(MOVD (QUOTE CADDDR)
(QUOTE P-V))
(MOVD (QUOTE CADDR)
(QUOTE IVAL))
(MOVD (QUOTE CDR)
(QUOTE IFEATURES))
(MOVD (QUOTE CDAR)
(QUOTE IMAT))
(MOVD (QUOTE CADR)
(QUOTE IFEA))
(MOVD (QUOTE CADAR)
(QUOTE CSINT))
(MOVD (QUOTE CDR)
(QUOTE CSOTHERS))
(MOVD (QUOTE CAR)
(QUOTE CSBEST))
(MOVD (QUOTE CADR)
(QUOTE CINT))
(MOVD (QUOTE CAAR)
(QUOTE COP))
(MOVD (QUOTE CDDDAR)
(QUOTE CARG))
(MOVD (QUOTE CADDR)
(QUOTE CWHY))
(MOVD (QUOTE LIST)
(QUOTE MAKE-CAND))
(MOVD (QUOTE CADAR)
(QUOTE CB))
(MOVD (QUOTE CADDAR)
(QUOTE CP))
(MOVD (QUOTE CAR)
(QUOTE CACT))
(SETQ HCON NIL) (* We will use the system hash list
instead of: (SETQ HCON
(HARRAY 503)))
(SETQ RANU (QUOTE DOUG))
(SETQ RANC (QUOTE ANYB))
(SETQQ RANF RAND-USER)
(SETQ CIRC (HARRAY 500))
(PUTHASH (QUOTE RAND-OBJ)
(QUOTE RAND-USER)
CIRC)
(PUTHASH (QUOTE RAND-USER)
(QUOTE RAND-CON)
CIRC)
(PUTHASH (QUOTE RAND-CON)
(QUOTE RAND-OBJ)
CIRC)
[MAPC FACETS (FUNCTION (LAMBDA (P)
(SETPROPLIST P (GETPROPLIST (GLUE (QUOTE ANYB)
P)))
(* Notice that if we really want to store meaningful properties on the Facets' value cells, we must
remove this clobberer. This has the effect of correcting any mistaken P instead of
(QUOTE P) errors.)
(SET P P]
(SETQ OBJX (EXS OBJECT))
[MAPC CONCEPTS (FUNCTION (LAMBDA (B)
(PUTHASH B B HCON)
(SET B TRIV-BVAL) (* Notice that if more than "from-file"
is to be stored, then the
list-structures that form the values of
the Beings must not be identical)
(* Unnecessary because Defb now does
this: (PUTD B (COPY TRIVB)))
(* a factor of 4 in speedup of (Ripple B (QUOTE Genl)) could be achieved by replacing each member of
each Genl by (List itself), then Rplacd each such small list G to
(Getb (Car G) (QUOTE Genl)). Then a Ripple is just
(Self-int (Flatten (Getp B (QUOTE Genl)))))
(DEFB B]
[MAP (SETQ R1 (DRAND-PERMUTE (COPY CONCEPTS)))
(FUNCTION (LAMBDA (C)
(PUTHASH (CAR C)
(CADR C)
CIRC] (* Here we have randomly permuted all
existing concepts, then linked them in
that order in the hash table CIRC)
(PUTHASH (CAR (LAST R1))
(CAR R1)
CIRC) (* We have just pointed the last such
permuted concept to the first, to
complete the circle)
[MAP (SETQ R1 (RAND-PERMUTE USERNAMES))
(FUNCTION (LAMBDA (C)
(PUTHASH (CAR C)
(CADR C)
CIRC] (* Form a similar circularly linked list
for generating random usernames)
(PUTHASH (CAR (LAST R1))
(CAR R1)
CIRC)
(CPRIN1 0 CRLF "There are " (LENGTH CONCEPTS)
" concepts in this incarnation of AM." CRLF)
(SETQ SUF1 CIRC)
(SETQ SUF2 NIL)
(SETQ SWSUF NIL)
(* We can overlay these three harrays onto CIRC and the system hash array:
(SETQ SUF1 (HARRAY 5)) (SETQ SUF2 (HARRAY 5)) (SETQ SWSUF
(HARRAY 10)))
[MAPC SUF-PARTS (FUNCTION (LAMBDA (FACET)
(PUTHASH FACET (PACK (LIST FACET 1))
SUF1)
(PUTHASH FACET (PACK (LIST FACET 2))
SUF2)
(PUTHASH (GETHASH FACET SUF2)
(GETHASH FACET SUF1)
SWSUF)
(PUTHASH (GETHASH FACET SUF1)
(GETHASH FACET SUF2)
SWSUF]
(MAPC SWORDS (QUOTE SELF))
(CPRIN1 0 CRLF "Initialization completed. To start AM, type (START)" CRLF)
(QUOTE OK])
)
(RPAQQ FACETS
(WORTH ALGS ANAS CHECK CHECK1 CHECK2 D-R DEFN DEFN-NEC DEFN-SUF EXS EXS-BDY EXS-NOT EXS-NOT-BDY FILLIN FILLIN1
FILLIN2 GENL IN-DOM-OF IN-RAN-OF INT INTU INV SPEC SUGG TIES UP UP-NOT VIEW))
(DEFINEQ
(WORTH
[NLAMBDA (B)
(PGET (QUOTE WORTH)
B])
(ALGS
[NLAMBDA (B)
(RIPPLE-UNTIL-P B (QUOTE GENL)
(QUOTE ALGS])
(ANAS
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE ANAS)
B BA1 BA2 BA3])
(CHECK
[NLAMBDA (B BA1 BA2 RS PP P RRS)
(SETQ RS (RIPPLE B (QUOTE GENL)))
[COND
((NOT (FMEMB (QUOTE ANYB)
RS))
(NCONC1 RS (QUOTE ANYB))
(NCONC RS (RIPPLE B (QUOTE UP]
(SETQQ PP CHECK)
[COND
((FMEMB BA1 FACETS)
(SETQ PP BA1)
[SETQ RS (MAPCONC RS (FUNCTION (LAMBDA (R)
(IS-CON-L (GLUE R BA1]
(SETQ RS (RIPPLE-L RS (QUOTE GENL] (* RS now holds the list of places to
look for checking information, ordered
from the current B onward toward ANYB)
(COND
((SETQ GEXISTING (GETB B PP))
(SETQ ORIG-EMP NIL)
(SETQ GEKNT (LENGTH GEXISTING))
(SETQ GNEKNT 0)
(SETQ GQEKNT 0)
(SETQ GTEKNT 0)
(SETQ GCEKNT 0) (* These 2 represent: the initial number
of entries, the number found to be
totally wrong, and the number which were
modified into correctness)
(SETQ RRS (REVERSE RS))
(* Note that we are daring to call on Check1 and CHeck2 directly, so we never pass along BA1 or BA2;
this might be dangerous. For that lack, we save on locating them as free vars for no reason;
BA1 will be assumed to be a part name anyway, so it is preprocessed already here)
(MAPC RRS (QUOTE CHECK1)) (* If user asks from whom the help came,
we can find out from RS)
(MAPC RS (QUOTE CHECK2))
(CPRIN1S 2 Checked (ENGN PP) of B)
[COND
((ZEROP (IPLUS GNEKNT GCEKNT GQEKNT GTEKNT))
(CPRIN1S 4 and all entries were confirmed))
(T (CPRIN1S 5 DCR TAB GEKNT entries were there initially DCR)
(COND
((NOT (ZEROP GCEKNT))
(CPRIN1S 5 TAB GCEKNT small modifications had to be made DCR)))
(COND
((NOT (ZEROP GQEKNT))
(CPRIN1S 5 TAB GQEKNT were never confirmed or rejected DCR)))
(COND
((NOT (ZEROP GNEKNT))
(CPRIN1S 5 TAB GNEKNT had to be completely discarded DCR)))
(COND
((NOT (ZEROP GTEKNT))
(CPRIN1S 5 TAB GTEKNT had to be transferred elsewhere DCR]
(CPRIN1S 2 CRLF)
(GETB B PP])
(CHECK1
[LAMBDA (B)
(APPLYB B (QUOTE CHECK1])
(CHECK2
[LAMBDA (B)
(APPLYB B (QUOTE CHECK2])
(D-R
[NLAMBDA (B)
(RIPPLE-UNTIL-P B (QUOTE GENL)
(QUOTE D-R])
(DEFN
[NLAMBDA (B BA1 BA2 BA3 BA4 TK2)
(COND
((FMEMB B DEFN-STAK)
NIL)
((ATTACH B DEFN-STAK)
[OR (NUMBERP TK2)
(SETQ TK2 (IPLUS (CLOCK 2)
(ITIMES CS-INT 6]
(SETQ CS-FAIL NIL) (* There are several ways in which we
can tell whether BA1 satisfies the
Definition of B)
(PROG1 (COND
((GETB B (QUOTE DEFN)) (* If there is a nec&suff defn around,
we just evaluate it)
(APPLYB B (QUOTE DEFN)
BA1 BA2 BA3 BA4))
((APPLYB B (QUOTE DEFN-SUF)
BA1 BA2 BA3 BA4) (* If there are suff defns around and
one evals to non-null)
T)
((AND (GETB B (QUOTE DEFN-NEC))
(NOT (APPLYB B (QUOTE DEFN-NEC)
BA1 BA2 BA3 BA4))) (* This AND kludge is because DEFB
doesnt know to insert a clause like
(DEFN-NEC T IN END))
(* If there are neccessary defns around
and one evals to null, then BA1 can't be
a B)
NIL)
((ILESSP TK2 (CLOCK 2))
(SETQ CS-FAIL T)
NIL)
([SOME (GETB B (QUOTE SPEC))
(FUNCTION (LAMBDA (Z)
(APPLY* (QUOTE DEFN)
Z BA1 BA2 BA3 BA4 TK2] (* If BA1 satisfies the Definition of
some Specialization of B)
(* DANGER: If Z's definition is of the
form (AND... (ISA BA1 b) ...) for the
current Being b)
T)
([SOME (GETB B (QUOTE GENL))
(FUNCTION (LAMBDA (Z)
(AND (GETB Z (QUOTE DEFN-NEC))
(NOT (APPLYB Z (QUOTE DEFN-NEC)
BA1 BA2 BA3 BA4] (* If BA1 fails to satisfy the
definition of any Generalization of B,
then it must also not satisfy B)
NIL)
((ILESSP TK2 (CLOCK 2))
(SETQ CS-FAIL T)
NIL)
((MEMBER BA1 (APPLY* (QUOTE EXS)
B))
T)
((FMEMB B (APPLY* (QUOTE UP)
BA1))
T)
([SOME (GETB B (QUOTE GENL))
(FUNCTION (LAMBDA (Z)
(AND (GETB Z (QUOTE DEFN))
(NOT (APPLYB Z (QUOTE DEFN)
BA1 BA2 BA3 BA4 (IPLUS 50 (CLOCK 2]
NIL)
(T
(* A final test, which we won't even do here, is the following: if B.Defn-nec exists, apply it;
if it succeeds, then GUESS that the answer is T)
(SETQ CS-FAIL T)
NIL))
(DREMOVE B DEFN-STAK])
(DEFN-NEC
[NLAMBDA (B BA1 BA2 BA3 BA4)
(EVERY (RIPPLE B (QUOTE GENL))
(FUNCTION (LAMBDA (Z)
(OR (NOT (GETB Z (QUOTE DEFN-NEC)))
(APPLYB Z (QUOTE DEFN-NEC)
BA1 BA2 BA3 BA4])
(DEFN-SUF
[NLAMBDA (B BA1 BA2 BA3 BA4)
(SOME (RIPPLE B (QUOTE SPEC))
(FUNCTION (LAMBDA (Z)
(APPLYB Z (QUOTE DEFN-SUF)
BA1 BA2 BA3 BA4])
(EXS
[NLAMBDA (B)
(* Since Fripple-S is fast at low
(already-specific) nodes but not at high ones, we
use it only to find specializations of examples of
specializations of B)
(ATOM-INT (MAPCONC (MAPCONC (RIPPLE B (QUOTE SPEC))
(QUOTE GETX))
(QUOTE FRIPPLE-S])
(EXS-BDY
[NLAMBDA (B)
(ATOM-INT (MAPCONC (MAPCONC (RIPPLE B (QUOTE SPEC))
(QUOTE GETXB))
(QUOTE FRIPPLE-S])
(EXS-NOT
[NLAMBDA (B)
(ATOM-INT (MAPCONC (MAPCONC (RIPPLE B (QUOTE GENL))
(QUOTE GETXNB))
(QUOTE FRIPPLE-G])
(EXS-NOT-BDY
[NLAMBDA (B)
(ATOM-INT (MAPCONC (MAPCONC (RIPPLE B (QUOTE GENL))
(QUOTE GETXNB))
(QUOTE FRIPPLE-G])
(FILLIN
[NLAMBDA (B BA1 BA2 RS PP RRS EPP)
(SETQ RS (RIPPLE-S2 B (QUOTE GENL)
(QUOTE UP)))
(SETQ PP (QUOTE FILLIN))
[COND
((FMEMB BA1 FACETS)
(SETQ PP BA1)
(SETQ RS (RIPPLE-L [MAPCONC RS (FUNCTION (LAMBDA (R)
(IS-CON-L (GLUE R BA1]
(QUOTE GENL]
[SETQ ORIG-EMP (NULL (SETQ GEXISTING (GETB B PP]
(SETQ GEKNT (LENGTH GEXISTING))
[COND
(ORIG-EMP (SETQ GEXISTING (INIT-PART B PP]
(SETQ RRS (REVERSE RS))
[SETQ FV1 (DREMOVE NIL (MAPCONC RRS (QUOTE FILLIN1]
(SETQ FL1 (LENGTH FV1))
(SETQ GEXISTING (NCONCB B PP (SELF-INT FV1)))
(* Note the danger in not providing Fillin1/2 with
any args except Being name)
[SETQ FV2 (DREMOVE NIL (MAPCONC RS (QUOTE FILLIN2]
(SETQ FL2 (LENGTH FV2))
(SETQ GEXISTING (NCONCB B PP (SELF-INT FV2)))
(SETQ FL3 (IPLUS FL1 FL2))
(SETQ FV3 (APPEND FV1 FV2))
(SETQ FL4 (IDIFFERENCE (LENGTH (GETB B PP))
GEKNT))
(SETQ EPP (ENGN PP))
(COND
((ZEROP FL4)
(CPRIN1 3 CRLF "Failed. Tried to fill in new " EPP SPACE
of SPACE B DCR))
(T (CPRIN1S 2 CRLF Filled in EPP of B DCR)
(CPRIN1S 5 TAB GEKNT EPP existed originally on B DCR)
(CPRIN1S 4 TAB FL3 potential new entries were just proposed
DCR)
(CPRIN1S 9 TAB FL1 found
on Pass 1 COMMA
then FL2 more derived DCR)
(COND
((IGREATERP VERBOSITY 9)
(CPRIN1S 9 CRLF Eliminating duplicates COMMA the newly
constructed EPP are:)
(PRINICE (SETQ FV3 (SELF-INT FV3)))
(TERPRI))
((IGREATERP VERBOSITY 4)
(CPRIN1S 4 CRLF One of these EPP is: SPACE (RAND-MEMB
FV3)
CRLF)))
(CPRIN1S 6 After eliminating duplicate
and already-known entries COMMA AM finds that DCR)
(CPRIN1S 2 (COND
((EQ FL3 FL4)
all)
(T only))
FL4 new COMMA distinct EPP of B had
to be added DCR CRLF)
(CPRIN1 9 CRLF)))
(GETB B PP])
(FILLIN1
[LAMBDA (B)
(APPLYB B (QUOTE FILLIN1])
(FILLIN2
[LAMBDA (B)
(APPLYB B (QUOTE FILLIN2])
(GENL
[NLAMBDA (B)
(FRIPPLE-G B])
(IN-DOM-OF
[NLAMBDA (B G P)
(SETQ P (QUOTE IN-DOM-OF))
(ATOM-INT (NCONC (SETQ G (MAPCONC (RIPPLE B (QUOTE GENL))
(QUOTE GETB-P-C)))
(MAPCONC G (QUOTE FRIPPLE-G])
(IN-RAN-OF
[NLAMBDA (B G P)
(SETQ P (QUOTE IN-RAN-OF))
(* Should we somehow go in the SPEC direction too or
instead? For example, add on all of these:
(MAPCONC (FRIPPLE-S B) (QUOTE GETB-P-C)), plus all
of THEIR specializations, etc.)
(ATOM-INT (NCONC (SETQ G (MAPCONC (RIPPLE B (QUOTE GENL))
(QUOTE GETB-P-C)))
(MAPCONC G (QUOTE FRIPPLE-G])
(INT
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE INT)
B BA1 BA2 BA3])
(INTU
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE INTU)
B BA1 BA2 BA3])
(INV
[NLAMBDA (B BA1 BA2 BA3 BA4)
(PXEQ (QUOTE INV)
B BA1 BA2 BA3 BA4])
(SPEC
[NLAMBDA (B)
(FRIPPLE-S B])
(SUGG
[NLAMBDA (B BA1 BA2 BA3)
(PXEQ (QUOTE SUGG)
B BA1 BA2 BA3])
(TIES
[NLAMBDA (B)
(PGET (QUOTE TIES)
B])
(UP
[NLAMBDA (B)
(SELF-INT (MAPCONC (MAPCONC (RIPPLE B (QUOTE GENL))
(QUOTE GETUP))
(QUOTE FRIPPLE-G])
(UP-NOT
[NLAMBDA (B)
(SELF-INT (MAPCONC (MAPCONC (RIPPLE B (QUOTE GENL))
(QUOTE GETUPN))
(QUOTE FRIPPLE-G])
(VIEW
[NLAMBDA (B BA1 BA2 BA3 BA4 RS VV)
(* B is the name of the type we wish to convert the
given to)
(* BA1 is the given
structure to be
converted)
(* BA2 is the name of
the given structure's
type)
(* BA4 is a flag which indicates whether this is a
top-level call or not)
(* This lets us supply RS if we know it, so as not
to keep recomputing it)
[OR RS (SETQ RS (RIPPLE-L (LIST B)
(QUOTE GENL]
(* 3 ways to do this: all non-top-level calls to
View use an extra flag; all toplevel calss insert
this extra T argument; inside View here, we check to
see if (CDR CAND) matches (VIEW B BA1...))
(* Tentative choice: All
non-top-level calls must
set BA4 non-null)
(CPRIN1S [SUB1 (SETQ VV (COND
(BA4 91)
(T 7]
CRLF Viewed BA1 COMMA which is a BA2 COMMA
as a B DCR)
(COND
((SOME-EBP RS (QUOTE VIEW)
B BA1 BA2 BA3 BA4)
(CPRIN1S VV TAB The actual viewing was done
by GSOME-ELE COMMA who said it was)
(SELECTQ (LENGTH GSOME-VAL)
(0 (CPRIN1S VV unviewable DCR))
(1 (CPRIN1S VV (CAR GSOME-VAL)
DCR))
(CPRIN1S VV any of these COLON CRLF TAB GSOME-VAL DCR))
GSOME-VAL)
(T (CPRIN1S (ADD1 VV)
TAB Failed DCR)
NIL])
)
[DECLARE: DOEVAL@COMPILE
(DATATYPE WORTH ((AESTH BITS 5)
(USE BITS 5)
(BORN BITS 9)
(TTIM BITS 9)
(TSIZ BITS 8)))
]
(RPAQQ RANDSTATE (-16919033123 . -20119183462))
(INIT-COMP)
(INIT1)
(ADVISE (QUOTE MAKEFILE)
(QUOTE BEFORE)
(QUOTE (WIDEPAPER T)))
(ADVISE (QUOTE MAKEFILE)
(QUOTE AFTER)
(QUOTE (WIDEPAPER NIL)))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA VECTOR TYPE STRUC SPLIST SADD PAIR OSET FORMAT EPRIN1S EPRIN1 CPRIN1S CPRIN1 COMMENT CLASS BAG ANY1OF)
(ADDTOVAR NLAML VIEW UP-NOT UP TIES SUGG SPEC INV INTU INT IN-RAN-OF IN-DOM-OF GENL FILLIN EXS-NOT-BDY EXS-NOT
EXS-BDY EXS DEFN-SUF DEFN-NEC DEFN D-R CHECK ANAS ALGS WORTH SWITCH SWHY SETBQ SELF-COMPILE SELF Q INCR
GETBQ BLIND-SEARCH AQ-LIST ANY3SAT ANY2SAT ANY1SAT ACEX-COPY ACEX)
]
(DECLARE: DONTCOPY
(FILEMAP (NIL (4512 209893 (@ 4524 . 4550) (ABBREV 4554 . 4873) (ABBREV1 4877 . 5123) (ABC1 5127 . 8023) (ABC2 8027
. 8391) (ABC3 8395 . 8718) (ABC4 8722 . 9448) (ABC5 9452 . 10609) (ABF1 10613 . 13400) (ABF2 13404 . 16071) (ABV1
16075 . 16874) (ABV2 16878 . 17861) (AC-EXS-FILLIN1 17865 . 21750) (AC-EXS-SUGG 21754 . 24871) (AC-XNB-FILLIN1 24875
. 28374) (AC-XNB-SUGG 28378 . 31505) (ACCESS 31509 . 31540) (ACEX 31544 . 32501) (ACEX-COPY 32505 . 32576) (ACEXA
32580 . 32731) (ACX1 32735 . 32799) (ACXE 32803 . 32859) (ADD-CANDS 32863 . 32990) (ADD1CAND 32994 . 33556) (ADD1KIL
33560 . 33688) (ALL-BUT-LAST 33692 . 33745) (ALREADY-COALESCED 33749 . 34289) (ALREADY-COMPOSED 34293 . 35279) (
ALREADY-MAP-JOINED 35283 . 35530) (ALREADY-MAP-REPLACED 35534 . 35792) (ALREADY-MAP-REPLACED2 35796 . 36088) (ANY1OF
36092 . 36223) (ANY1OF-SATISFYING 36227 . 36453) (ANY1SAT 36457 . 36540) (ANY2OF-SATISFYING 36544 . 37171) (ANY2SAT
37175 . 37297) (ANY3OF-SATISFYING 37301 . 37941) (ANY3SAT 37945 . 38080) (APPENDB 38084 . 38201) (APPLYB-DEFN 38205
. 38328) (APPLYB-P 38332 . 38391) (AQ-LIST 38395 . 38509) (ARE-EQUI1 38513 . 39012) (ARE-EQUIV 39016 . 40377) (
ARE-NOT-EQUIV 40381 . 41174) (ARG-CHECK 41178 . 41417) (ARG-SUBST 41421 . 41873) (ATOM-INT 41877 . 42080) (AVG2 42084
. 42151) (BAG 42155 . 42204) (BIGGEST 42208 . 42420) (BLIND-SEARCH 42424 . 44883) (BLOWUP-CANR 44887 . 46677) (
BLOWUP-COALES 46681 . 50672) (BLOWUP-COMPOSE 50676 . 53809) (BLOWUP-INTERESTING-SPEC 53813 . 56836) (BLOWUP-INV 56840
. 60074) (BLOWUP-MAP-JOIN 60078 . 62723) (BLOWUP-MAP-REPLACE 62727 . 65321) (BLOWUP-MAP-REPLACE2 65325 . 68110) (
BLOWUP-NEW-SPEC 68114 . 70221) (BLOWUP-RESTRIC 70225 . 75227) (BOOST 75231 . 75337) (BOOST1 75341 . 75445) (BPFS 75449
. 75497) (BRIEF-U 75501 . 76172) (BRIEFLITE 76176 . 77420) (BRIEFNOT 77424 . 77541) (BRIEFULL 77545 . 78900) (CADDDDR
78904 . 78949) (CAN-BE-1-STYPE 78953 . 80550) (CANON-SUG 80554 . 83231) (CAVG 83235 . 83399) (CHECK-RES 83403 . 83625)
(CINL 83629 . 83724) (CLASS 83728 . 83781) (CLASS-IF-NNIL 83785 . 83999) (COMMENT 84003 . 84060) (CON-MERGE-ARGS 84064
. 88307) (CONFIRM-RPART 88311 . 90316) (CONSTANTT 90320 . 90349) (CONTRAST-DEFNS 90353 . 90633) (CPRIN1 90637 . 91129)
(CPRIN1S 91133 . 91634) (CR-INVERT 91638 . 92039) (CREATEB 92043 . 92514) (DE-THRESH 92518 . 92725) (DECRB 92729 .
92847) (DEDUCE-CANON 92851 . 96508) (DEDUCE-CANON-OBJ 96512 . 98971) (DEDUCE-RPART 98975 . 99390) (DEFB 99394 . 100317)
(DEFN-AC 100321 . 100622) (DO-KILS 100626 . 101705) (DOTPROD 101709 . 101888) (DOTS 101892 . 102014) (DRAND-PERMUTE
102018 . 102127) (DSET-DIFF 102131 . 102229) (DWIMUSERFN 102233 . 102622) (EAVG2 102626 . 102683) (ENGC 102687 . 103624)
(ENGN 103628 . 104200) (ENGR 104204 . 104689) (ENSURE 104693 . 105000) (ENSURE-TOP 105004 . 105497) (ENSURE1 105501
. 105623) (EPRIN1 105627 . 106076) (EPRIN1S 106080 . 106708) (EQPE 106712 . 106756) (ESUB2 106760 . 106808) (EVERY2
106812 . 106960) (EXPERIMENT-MUL 106964 . 109870) (EXPERIMENT-ORD 109874 . 112086) (FIL-ACEX 112090 . 112171) (FIL-EX1
112175 . 112716) (FIL-EX2 112720 . 114113) (FIL-EX3 114117 . 114819) (FIL-STRUC-P 114823 . 115410) (FIND-NEW-CANDS
115414 . 115637) (FIRSTN 115641 . 115737) (FLATTEN 115741 . 115842) (FORMAT 115846 . 115901) (FOU 115905 . 115958)
(FOU1 115962 . 116013) (FOU2 116017 . 116077) (FRIPPLE-G 116081 . 116181) (FRIPPLE-S 116185 . 116496) (FSET-NTH 116500
. 116567) (GARGS 116571 . 116669) (GATH 116673 . 117035) (GEARGS 117039 . 117104) (GENL1RDEF 117108 . 120562) (
GENLIZE-RECDEF 120566 . 123426) (GET-NAMES 123430 . 123978) (GET-SEEN 123982 . 126711) (GET-UCON 126715 . 127953)
(GET-VERBO 127957 . 129188) (GET-WAIT 129192 . 130309) (GETARGS 130313 . 130363) (GETB-OR 130367 . 130432) (GETB-P
130436 . 130475) (GETB-P-C 130479 . 130526) (GETBQ 130530 . 130571) (GETFNAME 130575 . 130626) (GETU 130630 . 130689)
(GETUP 130693 . 130747) (GETUPN 130751 . 130810) (GETX 130814 . 130868) (GETXB 130872 . 130931) (GETXNB 130935 . 130999)
(GEXADD 131003 . 131076) (GFNAME 131080 . 131263) (GFNAMES 131267 . 131348) (GLUE 131352 . 131558) (GLUE-CANO 131562
. 131649) (GLUE-IF-ABLE 131653 . 132377) (GLUEC 132381 . 132463) (GLUEE 132467 . 132676) (GRAND-STRUC 132680 . 132993)
(GS-CHECK 132997 . 133348) (GTRANSFER 133352 . 133976) (HANDLE-CANON 133980 . 139255) (HANDLE-I 139259 . 139858) (
HANDLE-I-INTERRUPT 139862 . 142037) (HANDLE-I1 142041 . 143303) (HANDLE-N 143307 . 143545) (I-USED 143549 . 143604)
(I-USED2 143608 . 143702) (I-USED3 143706 . 143791) (IMATRIX 143795 . 143822) (IN-A-LOOP 143826 . 144225) (IN-FACTOR
144229 . 144322) (INCR 144326 . 144375) (INCR-TIE 144379 . 144686) (INCR-USED 144690 . 145167) (INCRB 145171 . 145470)
(INDUCE-CANON-STYPE 145474 . 147274) (INIT-VARS 147278 . 148095) (INS1CAND 148099 . 148315) (INSTAN-1D 148319 . 150366)
(INSTAN-1I 150370 . 150422) (INSTAN-1S 150426 . 150462) (INSTAN-ACT-TRANS 150466 . 152286) (INSTAN-BASE 152290 . 152605)
(INSTAN-D 152609 . 152802) (INSTAN-I 152806 . 152867) (INSTAN-PAT 152871 . 153496) (INSTAN-REC 153500 . 154358) (
INSTAN-S 154362 . 154423) (INSTAN-TRANSF 154427 . 155958) (INT-CONS 155962 . 156453) (INT-ENUF 156457 . 157418) (
INT-PREDS 157422 . 157655) (INV-EX 157659 . 157781) (INV-STYP 157785 . 158213) (INVQ 158217 . 158290) (IS-CON 158294
. 158339) (IS-CON-L 158343 . 158407) (IS-CONN 158411 . 158522) (IS-CONSTANTT 158526 . 158580) (IS-ONE-OF 158584 .
158747) (ISA 158751 . 159863) (ISA1 159867 . 160468) (ISAG 160472 . 160589) (ISAS 160593 . 160710) (ISQ 160714 . 160767)
(IVOP-CHK1 160771 . 161375) (IVOP-FIL1 161379 . 162330) (KILB 162334 . 163110) (KINDS-OF 163114 . 163368) (LAPP 163372
. 163518) (LARGER 163522 . 163595) (LASTELE 163599 . 163681) (LINN 163685 . 163824) (LLOCATE 163828 . 164368) (LLOCX
164372 . 164418) (LONGEST 164422 . 164636) (M2 164640 . 166621) (MAKE-IDENTICAL 166625 . 166883) (MAP-JOINABLE 166887
. 167564) (MAP-REPLACE2ABLE 167568 . 168190) (MAP-REPLACEABLE 168194 . 168760) (MAPAPPEND 168764 . 168843) (MAX2 168847
. 169099) (MAXI 169103 . 169398) (MERGE2BS 169402 . 170451) (MIN2 170455 . 170698) (MOST-OF 170702 . 171016) (
MULT-STRUC-PAIR 171020 . 171179) (NCONCB 171183 . 171330) (NEWNAME 171334 . 171625) (NOT-USED-YET 171629 . 171686)
(ONE-ISA 171690 . 171787) (ONE-ISAG 171791 . 171890) (ORD-STRUC-PAIR 171894 . 172165) (ORDINAL 172169 . 172309) (OSET
172313 . 172364) (OUTA 172368 . 172680) (PAD 172684 . 172770) (PAD1 172774 . 172834) (PADI 172838 . 172975) (PAIR
172979 . 173030) (PGET 173034 . 173131) (PICK-CAND 173135 . 174673) (POR 174677 . 174817) (PRINES 174821 . 174887)
(PRINICE 174891 . 174980) (PRUNABLE 174984 . 175045) (PRUNE 175049 . 175316) (PSUF 175320 . 175981) (PUTB 175985 .
176068) (PXEQ 176072 . 176594) (Q 176598 . 176649) (RAISE-WORTH 176653 . 176911) (RAND-ACEX-MEMB 176915 . 176996)
(RAND-CON 177000 . 177061) (RAND-INCRB 177065 . 177609) (RAND-MEMB 177613 . 177694) (RAND-OBJ 177698 . 177791) (
RAND-PERMUTE 177795 . 178077) (RAND-PRED 178081 . 178130) (RAND-SUBSET 178134 . 178195) (RAND-THING 178199 . 178258)
(RAND-USER 178262 . 178324) (RANDQMEMB 178328 . 178416) (RCON 178420 . 178825) (REBB 178829 . 179054) (RECENTLY-TRIED
179058 . 179123) (RECTANGLE 179127 . 179409) (REM-ALLEV 179413 . 179559) (REM-ONCE 179563 . 179792) (RENAME2BS 179796
. 180255) (RIGHT-STRUC 180259 . 180377) (RIPPLE 180381 . 180762) (RIPPLE-L 180766 . 181033) (RIPPLE-S2 181037 . 181411)
(RIPPLE-UNTIL 181415 . 181905) (RIPPLE-UNTIL-P 181909 . 182300) (RMUL 182304 . 182388) (RNUM 182392 . 182520) (RPLACINT
182524 . 182581) (RUN-ANAS 182585 . 182642) (RUN-OPS-TO-GET 182646 . 184012) (RUN1ANA 184016 . 184131) (S-DECODE 184135
. 184187) (SAD2 184191 . 184487) (SAD3 184491 . 184686) (SADD 184690 . 184957) (SCDR 184961 . 185057) (SELF 185061
. 185098) (SELF-COMPILE 185102 . 185312) (SELF-INT 185316 . 185365) (SET-DIFF 185369 . 185575) (SET-DIFFER2 185579
. 185669) (SET-DIFFERENCE 185673 . 185780) (SET-NTH 185784 . 185994) (SETB 185998 . 186320) (SETBQ 186324 . 186375)
(SIMPLIFY1 186379 . 191134) (SIMULT-SATISFY 191138 . 192657) (SMALLER 192661 . 192734) (SOFS 192738 . 192952) (
SOFS-DECODE 192956 . 193199) (SOME-EBP 193203 . 193687) (SOMEE 193691 . 193877) (SORD 193881 . 194121) (SORTED 194125
. 194195) (SORV 194199 . 194269) (SPECL1RDEF 194273 . 197726) (SPECLIZE-RECDEF 197730 . 200438) (SPECLIZE-TRANSDEF
200442 . 202424) (SPLIST 202428 . 202698) (SSORT 202702 . 202760) (STACK-BS 202764 . 202891) (START 202895 . 203266)
(STRUC 203270 . 203323) (STRUC-PAIR 203327 . 203447) (STRUCHECK 203451 . 203642) (STRUCTYP? 203646 . 204523) (STRUCTYPE
204527 . 204787) (SUB-ONCE 204791 . 205080) (SUBSET-INVOLVING-ONLY 205084 . 205309) (SUGGEST 205313 . 205527) (SWHY
205531 . 205695) (SWITCH 205699 . 205805) (SYM-XEQ 205809 . 206265) (TIMES1000 206269 . 206340) (TLOOP 206344 . 206817)
(TYPE 206821 . 206867) (UNFORGETTABLE 206871 . 207260) (UNTANGLE-ARGS 207264 . 208383) (UP-THRESH 208387 . 208781)
(UPDATE 208785 . 209603) (USED-YET 209607 . 209722) (VECTOR 209726 . 209781) (XEQ-CAND 209785 . 209890)) (209895 216562
(INIT1 209907 . 210884) (INIT-COMP 210888 . 211804) (INIT-C 211808 . 216559)) (216777 227876 (WORTH 216789 . 216844)
(ALGS 216848 . 216926) (ANAS 216930 . 217007) (CHECK 217011 . 219171) (CHECK1 219175 . 219228) (CHECK2 219232 . 219285)
(D-R 219289 . 219365) (DEFN 219369 . 221859) (DEFN-NEC 221863 . 222070) (DEFN-SUF 222074 . 222238) (EXS 222242 . 222556)
(EXS-BDY 222560 . 222690) (EXS-NOT 222694 . 222825) (EXS-NOT-BDY 222829 . 222964) (FILLIN 222968 . 224945) (FILLIN1
224949 . 225004) (FILLIN2 225008 . 225063) (GENL 225067 . 225108) (IN-DOM-OF 225112 . 225305) (IN-RAN-OF 225309 .
225712) (INT 225716 . 225791) (INTU 225795 . 225872) (INV 225876 . 225959) (SPEC 225963 . 226004) (SUGG 226008 . 226085)
(TIES 226089 . 226142) (UP 226146 . 226271) (UP-NOT 226275 . 226405) (VIEW 226409 . 227873)))))
STOP